perm filename QIO[NEW,LSP]3 blob
sn#398847 filedate 1978-11-27 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00048 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 -*-MIDAS-*-
C00007 00003
C00010 00004
C00012 00005
C00015 00006
C00036 00007
C00039 00008
C00048 00009
C00062 00010
C00066 00011
C00069 00012
C00075 00013
C00081 00014
C00089 00015
C00094 00016
C00097 00017
C00101 00018
C00105 00019
C00114 00020
C00119 00021
C00122 00022
C00124 00023
C00130 00024
C00133 00025
C00143 00026
C00151 00027
C00154 00028
C00157 00029
C00159 00030
C00161 00031
C00163 00032
C00166 00033
C00172 00034
C00175 00035
C00178 00036
C00182 00037
C00188 00038
C00191 00039
C00194 00040
C00202 00041
C00208 00042
C00212 00043
C00216 00044
C00218 00045
C00220 00046
C00222 00047
C00236 00048
C00237 ENDMK
C⊗;
;;; -*-MIDAS-*-
;;; **************************************************************
;;; ***** MACLISP ****** NEW MULTIPLE FILE I/O FUNCTIONS *********
;;; **************************************************************
;;; ** (C) COPYRIGHT 1978 MASSACHUSETTS INSTITUTE OF TECHNOLOGY **
;;; ****** THIS IS A READ-ONLY FILE! (ALL WRITES RESERVED) *******
;;; **************************************************************
PGBOT [QIO]
SUBTTL I/O CHANNEL ALLOCATOR
;;; ALCHAN ALLOCATES AN I/O CHANNEL FOR USE.
;;; THE "CHANNEL NUMBER" IS AN INDEX INTO THE CHANNEL TABLE.
.SEE CHNTB
;;; FOR ITS AND DEC10, THIS IS ALSO THE CHANNEL NUMBER USED TO
;;; COMMUNICATE WITH THE TIMESHARING SYSTEM. (FOR DEC20, A
;;; SEPARATE JFN MUST BE ALLOCATED WITH THE GTJFN JSYS.)
;;; ALCHAN EXPECTS THE SAR FOR THE FILE ARRAY TO BE IN A,
;;; AND RETURNS THE CHANNEL NUMBER IN F, SKIPPING IF SUCCESSFUL.
;;; THE FILE ARRAY MUST HAVE ITS TTS.CL BIT SET.
;;; THE CHANNEL NUMBER IS INSTALLED IN THE FILE'S F.CHAN SLOT.
;;; USER INTERRUPTS TURNED OFF, PLEASE. CLOBBERS R.
;;; MAY INVOKE A GARBAGE COLLECTION TO FREE UP CHANNELS.
ALCHAN: HRRZS (P)
ALCHN0: MOVNI F,LCHNTB-2 ;SCAN CHANNEL TABLE
ALCHN1: SKIPN R,CHNTB+LCHNTB-1(F)
JRST ALCHN3 ;FOUND A FREE CHANNEL
JUMPL R,ALCH1A ;NEGATIVE, RESERVED
MOVE R,TTSAR(R)
TLNE R,TTS<CL>
JRST ALCHN2 ;SEMI-FREE
ALCH1A: AOJLE F,ALCHN1 ;DON'T CHECK CHANNEL 0 (NEVER FREE)
SKIPGE (P) ;SKIP IF FIRST TIME
POPJ P, ;LOSEY LOSEY
HRROS (P) ;SET SWITCH
PUSH P,[555555,,ALCHN0]
JRST AGC ;HOPE GC WILL RECLAIM A FILE ARRAY
ALCHN2: MOVEI F,LCHNTB-1(F)
IT$ .CALL ALCHN9 ;CLOSE CHANNEL TO BE SURE
IT$ .LOSE 1400
IFN D10,[
MOVEI R,(F)
LSH R,27
IOR R,[RELEASE 0,0] ;RELEASE CHANNEL TO BE SURE
XCT R
] ;END OF IFN D10
SKIPA
ALCHN3: MOVEI F,LCHNTB-1(F)
MOVE R,TTSAR(A) ;INSTALL CHANNEL NUMBER
MOVEM F,F.CHAN(R)
MOVEM A,CHNTB(F) ;RESERVE CHANNEL
JRST POPJ1 ;WIN WIN - SKIP RETURN
IFN ITS,[
ALCHN9: SETZ
SIXBIT \CLOSE\ ;CLOSE I/O CHANNEL
400000,,F ;CHANNEL #
] ;END OF IFN ITS
;;; ALFILE CREATES A MINIMAL FILE ARRAY (OF LENGTH LOPOFA),
;;; AND ALLOCATES A CHANNEL FOR IT. IT EXPECTS A DEVICE NAME
;;; IN TT (FOR DEC20, TT AND D) WHICH IS INSTALLED IN THE
;;; F.DEV AND F.RDEV SLOTS OF THE FILE ARRAY.
;;; THIS IS USEFUL FOR ROUTINES WHICH WANT TO HACK ON A
;;; RANDOM CHANNEL BUT DON'T NEED A FULL-BLOWN FILE ARRAY.
;;; A FILE ARRAY IS NEEDED FOR THE SAKE OF THE CHANNEL TABLE
.SEE CHNTB
;;; AND FOR THE GARBAGE COLLECTOR; IF THE FILE ARRAY IS
;;; GARBAGE COLLECTED, SO IS THE ASSOCIATED CHANNEL.
;;; THE FILE ARRAY ALSO MUST CONTAIN AT LEAST A DEVICE
;;; NAME SO PRIN1 CAN WIN.
.SEE PRNFL
;;; CLOBBERS PRACTICALLY ALL ACS.
;;; THE ARRAY GC POINTER IS SET TO PROTECT THE FIRST SLOT ONLY.
;;; RETURNS FILE ARRAY IN A, CHANNEL NUMBER IN F.
;;; SKIPS ON SUCCESS; FAILS IF ALCHAN CAN'T GET A CHANNEL.
ALFILE: LOCKI
PUSH FXP,TT
MOVEI TT,LOPOFA ;LENGTH OF PLAIN OLD FILE ARRAY
MOVSI A,-1 ;GET ONLY A SAR
PUSHJ P,MKLSAR
MOVSI TT,TTS<CL> ;SET CLOSED BIT
IORB TT,TTSAR(A)
MOVSI T,AS<FIL> ;SET FILE ARRAY BIT (MUST DO
IORB T,ASAR(A) ; IN THIS ORDER!)
HRROS -1(T) ;GC SHOULD PROTECT ONLY ONE SLOT
POP FXP,T
MOVEM T,F.DEV(TT) ;INSTALL DEVICE NAME
20% MOVEM T,F.RDEV(TT)
MOVSI T,FBT.CM ;PREVENT GC FROM TRYING TO
MOVEM T,F.MODE(TT) ; UPDATE NONEXISTENT POINTERS
PUSHJ P,ALCHAN
JRST UNLKPJ
AOS (P) ;WE SKIP IFF ALCHAN DOES
MOVSI TT,TTS<CL>
ANDCAM TT,TTSAR(A)
UNLKPJ: UNLKPOPJ
SUBTTL FILE OBJECT CHECKING ROUTINES
;;; JSP TT,XFILEP
;;; SKIPS IFF THE OBJECT IN AR1 IS A FILE ARRAY. CLOBBERS R.
SFA% AFOSP:
AFILEP: MOVEI AR1,(A)
SFA% XFOSP:
XFILEP: MOVEI R,(AR1)
LSH R,-SEGLOG
MOVE R,ST(R)
TLNN R,SA
JRST (TT)
MOVE R,ASAR(AR1) ;MUST ALSO HAVE FILE BIT SET
TLNN R,AS<FIL>
JRST (TT)
JRST 1(TT)
FILEP: JSP TT,AFILEP ;SUBR 1
JRST FALSE
JRST TRUE
IFN SFA,[
; PARALLEL TOO AFILEP/XFILEP BUT SKIPS ONCE FOR FILE-OBJECT, AND TWICE
; FOR SFA-OBJECT
AFOSP: MOVEI AR1,(A)
XFOSP: MOVEI R,(AR1)
LSH R,-SEGLOG
MOVE R,ST(R)
TLNN R,SA ;MUST BE A SAR
JRST (TT)
MOVE R,ASAR(AR1) ;DOES IT HAVE FILE BIT SET?
TLNE R,AS<FIL>
JRST 1(TT) ;YES, SINGLE SKIP
TLNE R,AS.SFA ;AN SFA?
JRST 2(TT) ;YES, DOUBLE SKIP
JRST (TT) ;ELSE ERROR RETURN
] ;END IFN SFA
IFN SAIL,[
SAEXT: CAMN TT,[SIXBIT \←←←\]
SETZ TT,
POPJ P,
] ;END IFN SAIL
;;; THESE ROUTINES ACCEPT A FILE ARRAY IN AR1 AND CHECK WHETHER
;;; IT IS OF THE DESIRED TYPE. IF NOT, A WTA ERROR OCCURS.
;;; LEAVES TTSAR IN TT AND USER INTS LOCKED IF SUCCESSFUL.
;;; CLOBBERS T, TT, AND R. SAVES D (SEE FILEPOS) AND F.
OFILOK: JSP T,FILOK0 ;TYPICAL INVOCATION:
TTS<IO>,,TTS<IO> ; DESIRED BITS,,MASK
SIXBIT \NOT OUTPUT FILE!\ ; ERROR MSG IF FAIL
IFILOK: JSP T,FILOK0
0,,TTS<IO>
SIXBIT \NOT INPUT FILE!\
ATFLOK: JSP T,FILOK0
0,,TTS<BN>
SIXBIT \NOT ASCII FILE!\
ATOFOK: JSP T,FILOK0
TTS<IO>,,TTS<BN+IO>
SIXBIT \NOT ASCII OUTPUT FILE!\
ATIFOK: JSP T,FILOK0
0,,TTS<BN+IO>
SIXBIT \NOT ASCII INPUT FILE!\
TFILOK: JSP T,FILOK0
TTS<TY>,,TTS<TY>
SIXBIT \NOT TTY FILE!\
TIFLOK: JSP T,FILOK0
TTS<TY>,,TTS<TY+IO>
SIXBIT \NOT TTY INPUT FILE!\
TOFLOK: JSP T,FILOK0
TTS<TY+IO>,,TTS<TY+IO>
SIXBIT \NOT TTY OUTPUT FILE!\
XIFLOK: JSP T,FILOK0
TTS<BN>,,TTS<IM+BN+IO>
SIXBIT \NOT BINARY INPUT FILE!\
XOFLOK: JSP T,FILOK0
TTS<BN+IO>,,TTS<IM+BN+IO>
SIXBIT \NOT BINARY OUTPUT FILE!\
FILOK: JSP T,FILOK0
0,,0
NFILE: SIXBIT \NOT FILE!\
FILOK0: LOCKI
CAIE AR1,TRUTH ;T => TTY FILE ARRAY
JRST FILOK1
MOVSI TT,TTS<IO>
TSNE TT,(T) ;IF DON'T CARE ABOUT I/O
TDNE TT,(T) ; OR SPECIFICALLY WANT OUTPUT
SKIPA AR1,V%TYO ; THEN USE TTY OUTPUT
HRRZ AR1,V%TYI ;USE TTY INPUT ONLY IF NECESSARY
FILOK1: JSP TT,XFILEP ;SO IS IT A FILE ARRAY?
JRST FILNOK ;NOPE - LOSE
MOVE TT,TTSAR(AR1)
XOR TT,(T)
HLL T,TT
MOVE TT,TTSAR(AR1) ;WANT TO RETURN TTSAR IN TT
TLNE T,@(T)
JRST FILNOK
TLNN TT,TTS<CL>
POPJ P, ;YEP - WIN
SKIPA TT,[[SIXBIT \FILE HAS BEEN CLOSED!\]]
FILNOK: MOVEI TT,1(T)
EXCH A,AR1
UNLOCKI
%WTA (TT)
EXCH A,AR1
JRST FILOK0
SUBTTL CONVERSION: NAMELIST => SIXBIT
;;; A NAMELIST IN A IS CONVERTED TO "SIXBIT" FORMAT ON THE FIXNUM PDL.
;;; "SIXBIT" FORMAT IS ACTUALLY SIXBIT FOR SOME OPERATING SYSTEMS,
;;; BUT MAY BE ANY ANY FORM WHATSOEVER AS LONG AS ALL ROUTINES WHICH
;;; CLAIM TO UNDERSTAND "SIXBIT" FORM AGREE ON WHAT THAT FORM IS.
;;; (SOME ROUTINES WHICH DO I/O DEPEND ON THIS FORMAT, FOR EXAMPLE
;;; ITS ROUTINES WHICH USE THE OPEN SYMBOLIC SYSTEM CALL.)
;;; "SIXBIT" FORMAT IS DEFINED AS FOLLOWS:
;;;
;;; FOR ITS: <SIXBIT DEVICE NAME>
;;; <SIXBIT SNAME>
;;; <SIXBIT FILE NAME 1>
;;; <SIXBIT FILE NAME 2> ;TOP OF STACK
;;; AN OMITTED COMPONENT CAN BE REPRESENTED BY EITHER A ZERO
;;; WORD OR SIXBIT \*\ (THE LATTER BEING THE CANONICAL CHOICE).
;;;
;;; FOR DEC10: <SIXBIT DEVICE NAME>
;;; <PROJ-PROG NUMBER>
;;; <SIXBIT FILE NAME>
;;; <SIXBIT EXTENSION> ;TOP OF STACK
;;; AN OMITTED COMPONENT CAN BE REPRESENTED BY EITHER A ZERO
;;; WORD OR SIXBIT \*\ (THE LATTER BEING THE CANONICAL CHOICE),
;;; EXCEPT FOR THE PPN, FOR WHICH 777777 INDICATES AN OMITTED HALFWORD.
;;;
;;; FOR DEC20: <ASCIZ DEVICE OR LOGICAL NAME>
;;; <ASCIZ DIRECTORY NAME>
;;; <ASCIZ FILE NAME>
;;; <ASCIZ EXTENSION/TYPE NAME>
;;; <ASCIZ VERSION/GENERATION> ;TOP OF STACK
;;; THE ENTRIES HERE ARE NOT SINGLE WORDS, BUT ARE OF
;;; RESPECTIVE LENGTHS (IN WORDS) L.6DEV, L.6DIR, L.6FNM,
;;; L.6EXT, L.6VRS.
;;;
;;; NOTE THAT FOR ALL SIXBIT FORMATS THE TOTAL LENGTH OF THE
;;; SIXBIT FORMAT IS L.F6BT. THIS DIVIDES INTO TWO PARTS:
;;; THE DEVICE/DIRECTORY, OF LENGTH L.D6BT, AND THE FILE NAME
;;; PROPER, OF LENGTH L.N6BT.
;;;
;;; THERE ARE FOUR KINDS OF FILE NAME SPECIFICATIONS.
;;; ONE IS A FILE OBJECT, WHICH IMPLIES THE NAME USED TO OPEN IT.
;;; ONE IS AN ATOMIC SYMBOL, WHICH IS TREATED AS A NAMESTRING.
;;; THE OTHER TWO ARE NAMELISTS, UREAD-STYLE AND NEWIO-STYLE.
;;; NEWIO-STYLE NAMELISTS HAVE NON-ATOMIC CARS, WHILE UREAD-STYLE
;;; NAMELISTS HAVE ATOMIC CARS. UREAD-STYLE NAMELISTS ARE MOSTLY
;;; FOR COMPATIBILITY WITH OLDIO, AND FOR USER CONVENIENCE.
;;;
;;; IN A NEWIO-STYLE NAMELIST, THE CAR IS A DEVICE/DIRECTORY
;;; SPECIFICATION, AND THE CDR A FILE NAME SPECIFICATION.
;;; IN PRINCIPLE EACH IS A LIST OF ARBITRARY LENGTH.
;;; IN PRACTICE, THERE IS A LIMIT FOR EACH OF THE PDP-10
;;; IMPLEMENTATIONS. THE CANONICAL NAMELIST FORMAT FOR
;;; EACH SYSTEM IS AS FOLLOWS:
;;; ITS: ((<DEVICE> <SNAME>) <FILE NAME 1> <FILE NAME 2>)
;;; TOPS10: ((<DEVICE> (<PROJ#> <PROG#>)) <FILE NAME> <EXTENSION>)
;;; SAIL: ((<DEVICE> (<PROJ> <PROG>)) <FILE NAME> <EXTENSION>)
;;; CMU: ((<DEVICE> <PPN>) <FILE NAME> <EXTENSION>)
;;; CMU ALSO ALLOWS TOPS10-STYLE NAMELISTS.
;;; TENEX: ((<DEVICE> <DIRECTORY>) <FILE NAME> <EXTENSION> <VERSION>)
;;; TOPS20: ((<DEVICE> <DIRECTORY>) <FILE NAME> <TYPE> <GENERATION>)
;;;
;;; ALL COMPONENTS ARE NOMINALLY ATOMIC SYMBOLS, EXCEPT <PROJ#> AND <PROG#>,
;;; WHICH ARE FIXNUMS. IF THE USER SUPPLIES A COMPONENT WHICH IS NOT
;;; A SYMBOL (AND IT CAN EVEN BE NON-ATOMIC IF THERE IS NO AMBIGUITY
;;; AS TO FORMAT), THEN IT IS EXPLODEC'D WITH BASE=10., PRINLEVEL=PRINLENGTH=NIL,
;;; AND *NOPOINT=T. A COMPONENT MAY BE "OMITTED" BY USING THE ATOMIC
;;; SYMBOL *. THIS DOES NOT MEAN A WILDCARD, BUT ONLY AN OMITTED COMPONENT.
;;;
;;; IF THE USER SUPPLIES A NAMELIST NOT IN CANONICAL FORM, THE CAR AND CDR
;;; ARE INDEPENDENTLY CANONICALIZED. THE CAR CAN BE ACANONICAL ONLY BY
;;; BEING A SINGLETON LIST; IN THIS CASE AN ATTEMPT IS MADE TO DECIDE
;;; WHETHER IT IS A DEVICE OR DIRECTORY SPECIFICATION. THIS IS DONE IN
;;; DIFFERENT WAYS ON DIFFERENT SYSTEMS. ON TOPS10, FOR EXAMPLE, AN ATOMIC
;;; SPECIFICATION IS NECESSARY A DEVICE AND NOT A PPN. ON THE OTHER HAND,
;;; ON ITS A LIST OF STANDARD DEVICE NAMES IS CHECKED.
;;; THE CDR CAN BE ACANONICAL BY BEING TOO SHORT, OR BY BEING A DOTTED LIST,
;;; OR BOTH. COMPONENTS ARE TAKEN IN ORDER UNTIL AN ATOMIC CDR IS REACHED.
;;; IF THIS CDR IS NIL, ALL REMAINING COMPONENTS ARE TAKEN TO BE *.
;;; OTHERWISE, ALL REMAINING COMPONENTS ARE * EXCEPT THE LAST, WHICH IS
;;; THAT ATOM IN THE CDR.
;;;
;;; A UREAD-STYLE NAMELIST IS NOMINALLY IN THE FORM (A B C D), WHERE
;;; A, AT LEAST, MUST BE ATOMIC. IT IS INTERPRETED AS IF IT WERE CONVERTED
;;; TO THE FORM ((C D) A B) [DEC20: ((C D) A * B)], AND THEN TREATING IT AS
;;; AN ORDINARY NAMELIST. (IF C AND D ARE MISSING, THEN (*) IS USED INSTEAD
;;; OF NIL AS THE CAR OF THE CONSTRUCTED NAMELIST.
NML6BT: JSP T,QIOSAV ;SAVE REGISTERS
NML6B5: PUSH P,A
HLRZ A,(A) ;CHECK CAR OF NAMELIST
JSP T,STENT
JUMPGE TT,NML6B2 ;JUMP IF UREAD-STYLE NAMELIST
PUSHJ P,NML6DV ;CONVERT DEVICE/DIRECTORY SPECIFICATION
JRST NML6B0 ;SKIPS UNLESS CONVERSION FAILED
HRRZ A,@(P)
PUSHJ P,NML6FN ;CONVERT FILE NAMES (LEAVES TAIL IN A)
JUMPE A,POP1J ;SUCCEED UNLESS TOO MANY FILE NAMES
NML6BZ: POPI FXP,L.N6BT ;POP FILE NAME CRUD
NML6B0: POPI FXP,L.D6BT ;POP DEVICE/DIRECTORY CRUD
POP P,A ;POP ORIGINAL ARGUMENT
WTA [INCORRECTLY FORMED NAMELIST!]
JRST NML6B5
NML6B2: HRRZ A,(P) ;HERE FOR UREAD-STYLE NAMELIST
PUSHJ P,NML6UF ;CONVERT FILE NAMES, BUT AT MOST TWO OF THEM
PUSHJ P,NML6DV ;NOW CONVERT THE DEVICE/DIRECTORY
JRST NML6BZ ;NOTE THAT POPI'S COMMUTE AT NML6BZ!
;AT THIS POINT THE WORDS ON FXP ARE IN THE WRONG ORDER, SO WE SHUFFLE THE STACK.
IFN ITS+D10,[
POP FXP,TT ;DIRECTORY
POP FXP,T ;DEVICE
EXCH T,-1(FXP) ;EXCH DEVICE WITH FN1
EXCH TT,(FXP) ;EXCH DIR WITH FN2
PUSH FXP,T ;PUSH FN1
PUSH FXP,TT ;PUSH FN2
] ;END OF IFN ITS+D10
IFN D20,[
MOVEI T,-L.F6BT+1(FXP)
HRLI T,-L.N6BT
PUSH FXP,(T) ;COPY THE FILE NAMES TO THE TOP
AOBJN T,.-1 ; OF THE STACK
MOVEI T,-L.F6BT-L.N6BT+1(FXP)
HRLI T,-L.F6BT+1(FXP)
BLT T,-L.N6BT(FXP) ;COPY ENTIRE "SIXBIT" SET DOWNWARD
POPI FXP,L.N6BT ;POP OFF EXTRANEOUS CRUD
] ;END OF IFN D20
JRST POP1J
;;; CONVERT FILE NAME LIST IN A TO "SIXBIT" FORM ON FXP.
;;; RETURNS THE UNUSED TAIL OF THE LIST IN A.
;;; NML6UF IS LIKE NML6FN, BUT NEVER GOBBLES MORE THAN TWO NAMES.
NML6FN:
20$ TDZA T,T
NML6UF:
20$ SETO T, ;UREAD-STYLE DISTINCTION ONLY MATTERS TO DEC20
20$ HRLM T,(P)
20$ PUSHN FXP,L.N6BT ;PUSH ROOM FOR THE FILE NAMES
20% REPEAT 2, PUSH FXP,[SIXBIT \*\] ;PUSH ROOM FOR THE FILE NAMES
JUMPE A,CPOPJ ;NULL LIST => ALL NAMES OMITTED
PUSH P,A
JSP T,STENT
JUMPGE TT,NML6F3 ;ATOM MEANS LAST COMPONENT
HLRZ A,(A)
20% PUSHJ P,SIXMAK ;CONVERT FIRST COMPONENT TO SIXBIT,
20% MOVEM TT,-1(FXP) ; AND CALL IT FILE NAME 1
IFN D20,[
PUSHJ P,PNBFMK ;CONVERT FIRST COMPONENT TO ASCIZ,
MOVEI T,-L.6FNM-L.6EXT-L.6VRS+1(FXP) ; AND CALL IT THE FILE NAME
HRLI T,PNBUF
BLT T,-L.6EXT-L.6VRS(FXP)
DPB NIL,[010700,,-L.6EXT-L.6VRS(FXP)] ;MAKE SURE LAST BYTE IS NULL
] ;END OF IFN D20
HRRZ A,@(P)
JUMPE A,POP1J ;EXIT IF ALL DONE
MOVEM A,(P)
IFN D20,[
JSP T,STENT
JUMPGE TT,NML6F3 ;ATOM MEANS LAST COMPONENT
HLRZ A,(A)
PUSHJ P,PNBFMK ;CONVERT NEXT COMPONENT TO ASCIZ,
MOVEI T,-L.6EXT-L.6VRS+1(FXP) ; AND CALL IT THE EXTENSION
HRLI T,PNBUF
BLT T,-L.6VRS(FXP)
DPB NIL,[010700,,-L.6VRS(FXP)] ;MAKE SURE LAST BYTE IS NULL
HRRZ A,@(P)
JUMPE A,POP1J ;EXIT IF ALL DONE
HRRZ T,(A) ;IF 3 COMPONENTS REMAIN, THEN VERSION EXISTS
HRRZ T,(T)
SKIPN T
SKIPL -1(P) ;FOR UREAD-STYLE NAMELISTS, READ AT MOST
SKIPA ; TWO COMPONENTS
JRST NML6F4
MOVEM A,(P)
NML6F5:
] ;END OF IFN D20
JSP T,STENT
JUMPGE TT,NML6F3 ;ATOM MEANS LAST COMPONENT
HLRZ A,(A)
NML6F2:
IFE D20,[
PUSHJ P,SIXMAK ;CONVERT LAST COMPONENT TO SIXBIT,
10$ TRZ TT,-1 ; TRUNCATING TO 3 CHARS FOR DEC10,
MOVEM TT,(FXP) ; AND CALL IT FILE NAME 2
] ;END OF IFN D20
IFN D20,[
PUSHJ P,PNBFMK ;CONVERT LAST COMPONENT TO ASCIZ,
MOVEI T,-L.6VRS+1(FXP) ; AND CALL IT THE VERSION
HRLI T,PNBUF
BLT T,(FXP)
DPB NIL,[010700,,(FXP)] ;MAKE SURE LAST BYTE IS NULL
] ;END OF IFN D20
NML6F4: HRRZ A,@(P)
JRST POP1J
NML6F3: SETZM (P)
20% JRST NML6F2
20$ JRST NML6F4
;;; CONVERTS A DEVICE/DIRECTORY SPECIFICATION IN A TO "SIXBIT" FORM ON FXP.
;;; PERFORMS DEVICE/DIRECTORY DISAMBIGUATION. SKIPS ON SUCCESS.
NML6DV:
IT$ REPEAT 2, PUSH FXP,[SIXBIT \*\] ;PUSH ROOM FOR DEV/DIR CRUD
10$ PUSH FXP,[SIXBIT \*\]
10$ PUSH FXP,[-1]
20$ PUSHN FXP,L.D6BT ;PUSH ROOM FOR DEV/DIR CRUD
JUMPE A,POPJ1 ;NULL SPEC => DEFAULTS
HRRZ B,(A)
HLRZ A,(A)
PUSH P,B
IFN D10,[
JSP T,STENT ;FOR D10, A NON-ATOMIC ITEM MUST BE A PPN
JUMPL TT,NML6D7
] ;END OF D10
20% PUSHJ P,SIXMAK
20$ PUSHJ P,PNBFMK
IFN ITS+D20+CMU,[
SKIPE (P) ;FOR ONLY ONE ITEM, IT COULD BE EITHER
JRST NML6D1 ; DEVICE OR DIRECTORY
PUSHJ P,IDND ;DISAMBIGUATE THIS MESS
IFN ITS+D20 JRST NML6D4 ;JUMP IF A DIRECTORY NAME
CMU$ JRST NML6D8
] ;END OF IFN ITS+D20+CMU
;FOR TOPS10 AND SAIL, AN ATOMIC ITEM MUST BE A DEVICE NAME (NOT TRUE OF CMU, THOUGH)
NML6D1:
20% MOVEM TT,-1(FXP) ;IT'S DEFINITELY A DEVICE NAME
IFN D20,[
MOVEI T,-L.6DEV-L.6DIR+1(FXP)
HRLI T,PNBUF
BLT T,-L.6DIR+1(FXP)
DPB NIL,[010700,,-L.6DIR(FXP)]
] ;END OF IFN D20
SKIPN (P)
JRST POP1J1 ;SUCCESS IF NO DIRECTORY SPEC
HLRZ A,@(P)
HRRZ B,@(P)
MOVEM B,(P)
;HERE IS WHERE IT HITS THE FAN - NO TWO SYSTEMS HAVE THE SAME DIRECTORY SPEC FORMAT!
IFN ITS, PUSHJ P,SIXMAK ;FOR ITS IT IS A PLAIN SIXBIT NAME
IFN D20, PUSHJ P,PNBFMK ;FOR D20 IT IS ASCII
IFN D10,[
JSP T,STENT
IFN TOPS10+SAIL, JUMPGE TT,POP1J ;AN ATOMIC DIRECTORY IS ILLEGAL FOR TOPS10/SAIL
IFN CMU,[
JUMPL TT,NML6D7 ;FOR CMU, NON-ATOMIC => TOPS10-STYLE
NML6D8: SETO TT,
CAIN A,Q. ;* AS A PPN STRING IS TAKEN TO MEAN (* *)
JRST NML6D4
PUSHJ P,PNBFMK
MOVEI TT,PNBUF ;0,,ADDRESS OF CMU PPN STRING
CMUDEC TT, ;CMUDEC WILL CONVERT A STRING TO A PPN WORD
JRST POP1J ;FAIL IF NOT A VALID CMU PPN
JRST NML6D4
] ;END OF IFN CMU
NML6D7: HLRZ B,(A) ;B GETS PROJECT
HRRZ C,(A)
HLRZ A,(C) ;A GETS PROGRAMMER
HRRZ C,(C)
JUMPN C,POP1J ;FAIL IF THREE ITEMS IN THE PPN SPEC
IFN TOPS10+CMU,[
CAIN B,Q. ;* MEANS AN OMITTED COMPONENT
SKIPA D,[,,-1]
JSP T,FXNV2 ;OTHERWISE EXPECT A FIXNUM
CAIN A,Q.
SKIPA TT,[,,-1]
JSP T,FXNV1
TLNN TT,-1
TLNE D,-1
JRST POP1J ;NUMBERS MUST FIT INTO HALFWORDS
HRLI TT,(D)
] ;END OF IFN TOPS10+CMU
IFN SAIL,[
PUSH P,B
CAIN A,Q. ;* MEANS AN OMITTED COMPONENT
SKIPA TT,[0,,-1]
PUSHJ P,SIXMAK ;OTHERWISE GET SIXBIT
PUSHJ P,SARGHT ;RIGHT JUSTIFY IT
PUSH FXP,TT
POP P,A
CAIN A,Q. ;* MEANS AN OMITTED COMPONENT
SKIPA TT,[0,,-1]
PUSHJ P,SIXMAK ;OTHERWISE GET SIXBIT
PUSHJ P,SARGHT ;RIGHT JUSTIFY IT
POP FXP,D
TLNN TT,-1
TLNE D,-1
JRST POP1J ;NO MORE THAN 3 CHARS APIECE
MOVSS TT
HRRI TT,(D)
] ;END OF IFN SAIL
] ;END OF IFN D10
;NOW WE HAVE THE SNAME/PPN IN TT FOR ITS/D10, OR DIRECTORY IN PNBUF FOR D20
NML6D4:
20% MOVEM TT,(FXP)
IFN D20,[
MOVEI T,-L.6DIR+1(FXP)
HRLI T,PNBUF
BLT T,(FXP)
DPB NIL,[010700,,(FXP)]
] ;END OF IFN D20
SKIPN (P) ;WE WIN IFF THERE ARE NO MORE ITEMS TO PARSE
AOS -1(P)
JRST POP1J
IFN SAIL,[
;RIGHT JUSTIFY SIXBIT WORD IN TT
SARGHT: SKIPE TT ;IF NOTHING THERE WE DON'T WANT TO LOOP
TRNE TT,77 ;ANYTHING IN HIGH SIXBIT BYTE?
POPJ P, ;YUP, IT IS THEREFORE LEFT-JUSTIFIED
LSH TT,-6 ;ELSE GET RID OF THE LEADING BLANK
JRST SARGHT ;AND PROCEED WITH TEST
] ;END IFN SAIL
IFN ITS+CMU+D20,[
;;; INSUFFERABLE DEVICE NAME DISTINGUISHER
;;; A NAME IS IN TT IN SIXBIT (ITS/CMU) OR IN PNBUF IN ASCII (D20).
;;; TRIES TO DECIDE WHETHER A NAME IS A DEVICE NAME OR A DIRECTORY NAME.
;;; FOR ITS, IT IS A DEVICE NAME IFF, AFTER STRIPPING OFF TRAILING DIGITS,
;;; IT IS IN THE TABLE OF KNOWN DEVICE NAMES.
;;; FOR CMU, WE USE THE DEVCHR UUO TO TEST EXISTENCE.
;;; FOR D20, WE USE THE STDEV JSYS TO TEST EXISTENCE.
;;; SKIPS IF A DEVICE NAME. MUST PRESERVE A AND TT.
IDND:
IFN CMU,[
MOVE F,TT
DEVCHR F, ;FOR CMU, GET CHARACTERISTICS OF DEVICE
JUMPE F,CPOPJ ;ZERO WORD MEANS DEVICE DOESN'T EXIST
JRST POPJ1
] ;END OF IFN CMU
IFN D20,[
PUSH P,A
LOCKI ;LOCK OUT INTERRUPTS AROUND THE JSYS
HRROI A,PNBUF
STDEV ;CONVERT DEVICE STRING TO DEVICE DESIGNATOR
CAIA ;ERROR - NO SUCH DEVICE
AOS -1(P) ;IF DEVICE, SKIP RETURN FOR STDEV AND US TOO
POP P,A
UNLKPOPJ
] ;END OF IFN D20
IFN ITS,[
MOVE F,TT
MOVE R,[000600,,TT]
;R NOW HAS A BYTE POINTER TO THE END OF THE NAME; WE WILL STRIP DIGITS.
SETZ T,
IDND1: LDB B,R ;GET CHARACTER FROM END
CAIL B,'0
CAILE B,'9
JRST IDND3 ;NOT A DIGIT
DPB NIL,R ;STRIP OFF DIGIT
ADD R,[060000,,] ;DECREMENT BYTE POINTER
SKIPGE R
SUB R,[440000,,1]
JRST IDND1
IDND3: MOVE R,[-LIDNTB,,IDNTB]
CAME TT,(R)
AOBJN R,.-1
MOVE TT,F ;RESTORE TT
JUMPGE R,CPOPJ ;NOT IN TABLE - MUST BE A DIRECTORY
JRST POPJ1 ;IT'S A DEVICE - SKIP RETURN
IDNTB:
IRP X,,[DSK,SYS,TTY,AI,MC,ML,DM,COM,T,TY,STY,ST,S,PK,P,DK,UT,MT
NUL,ARC,AR,DIR,AIDIR,MCDIR,MLDIR,DMDIR,TPL,CLO,CLU,CLI,CLA
USR,DIS,JOB,BOJ,OJB,ERR,SPY,COR,LPT,PTP,PTR]
SIXBIT \X\
TERMIN
LIDNTB==:.-IDNTB
] ;END OF IFN ITS
] ;END OF IFN ITS+CMU+D20
SUBTTL CONVERSION: SIXBIT => NAMELIST
;;; THIS ROUTINE TAKES "SIXBIT" FORMAT ON FXP AND,
;;; POPPING THEM, RETURNS THE EQUIVALENT CANONICAL NAMELIST.
;;; OMITTED COMPONENTS BECOME *'S.
;;; THE NAMELIST FUNCTION MERELY CONVERTS ARG TO SIXBIT,
;;; THEN BACK TO (CANONICAL) NAMELIST FORM.
NAMELIST:
PUSHJ P,FIL6BT ;SUBR 1
6BTNML: JSP T,QIOSAV ;MUST ALSO PRESERVE F
PUSHN P,1
;FOR D20, POP THE VERSION (TENEX)/GENERATION (TOPS20) AND CONS IT UP
IFN D20,[
REPEAT L.6VRS, POP FXP,PNBUF+L.6VRS-.RPCNT-1
PUSHJ P,6BTNL3
] ;END OF IFN D20
;POP THE FILE NAME 2 (ITS)/EXTENSION (D10, TENEX)/TYPE (TOPS20) AND CONS UP
IFN ITS+D10, POP FXP,TT
IFN D10, TRZ TT,-1 ;D10 EXTENSION IS AT MOST 3 CHARACTERS
IFN D20,[
MOVEI T,PNBUF
HRLI T,-L.6EXT+1(FXP)
BLT T,PNBUF+L.6EXT-1
POPI FXP,L.6EXT
] ;END OF IFN D20
PUSHJ P,6BTNL3
;POP THE FILE NAME 1 (ITS)/FILE NAME (D10, D20) AND CONS UP
IFN ITS+D10, POP FXP,TT
IFN D20,[
MOVEI T,PNBUF
HRLI T,-L.6FNM+1(FXP)
BLT T,PNBUF+L.6FNM-1
POPI FXP,L.6FNM
] ;END OF IFN D20
PUSHJ P,6BTNL3
;NOW FOR THE DEVICE/DIRECTORY PORTION
PUSHN P,1
;FIRST THE DIRECTORY (WHAT A MESS!)
IFN ITS,[
POP FXP,TT
PUSHJ P,6BTNL3
] ;END OF IFN ITS
IFN D10,[
POP FXP,TT
PUSHJ P,PPNATM
PUSHJ P,6BTNL4
] ;END OF IFN D10
IFN D20,[
MOVEI T,PNBUF
HRLI T,-L.6DIR+1(FXP)
BLT T,PNBUF+L.6DIR-1
POPI FXP,L.6DIR
PUSHJ P,6BTNL3
] ;END OF IFN D20
;FINALLY, THE DEVICE NAME
20% POP FXP,TT
IFN D20,[
MOVEI T,PNBUF
HRLI T,-L.6DEV+1(FXP)
BLT T,PNBUF+L.6DEV-1
POPI FXP,L.6DEV
] ;END OF IFN D20
PUSHJ P,6BTNL3
POP P,A
POP P,B
JRST CONS
SA$ 6BTNL9: SKIPA A,[Q.]
6BTNL3:
20% PUSHJ P,SIXATM
20$ PUSHJ P,PNBFAT
6BTNL4: MOVE B,-1(P)
PUSHJ P,CONS
MOVEM A,-1(P)
POPJ P,
SUBTTL CONVERSION: SIXBIT => NAMESTRING
;;; THIS ROUTINE TAKES A "SIXBIT" FORMAT FILE SPEC ON FXP
;;; AND GENERATES AN UNINTERNED ATOMIC SYMBOL WHOSE
;;; PRINT NAME IS THE EXTERNAL FORM OF FILE SPECIFICATION.
;;; OMITTED NAMES ARE EITHER NOT INCLUDED IN THE NAMESTRING
;;; OR REPRESENTED AS "*".
;;; THE NAMESTRING AND SHORTNAMESTRING MERELY CONVERT THEIR
;;; ARGUMENTS TO SIXBIT AND THEN INTO NAMESTRING FORM.
SHORTNAMESTRING: ;SUBR 1
TDZA TT,TT
NAMESTRING: ;SUBR 1
SETO TT,
HRLM TT,(P)
PUSHJ P,FIL6BT
6BTNMS: PUSHJ P,6BTNS ;TO MAKE A NAMESTRING, GET IT INTO PNBUF
JRST PNGNK2 ; AND THEN PNGNK2 WILL MAKE A SYMBOL
IFN D20,[
X6BTNS: MOVEI T,L.F6BT ;MAKES A STRING IN PNBUF WITHOUT REALLY
PUSH FXP,-L.F6BT+1(FXP) ; POPPING THE FILE NAMES (WE COPY THEM FIRST)
SOJG T,.-1
] ;END OF IFN D20
6BTNS: JSP T,QIOSAV ;CONVERT "SIXBIT" TO A STRING IN PNBUF
; (BETTER BE BIG ENOUGH!)
SETOM LPNF ;SET FLAG SAYING IT FITS IN PNBUF
20% MOVEI R,↑Q ;R CONTAINS THE CHARACTER FOR QUOTING
20$ MOVEI R,↑V ; PECULIAR CHARACTERS IN COMPONENTS
MOVE C,PNBP
SKIPL -6(P) ;SKIP UNLESS SHORTNAMESTRING
JRST 6BTNS0
;DEVICE NAME (NOT FOR SHORTNAMESTRING, THOUGH)
IFN ITS+D10,[
SKIPE TT,-3(FXP)
CAMN TT,[SIXBIT \*\]
JRST 6BNS0A ;JUMP IF DEVICE NAME OMITTED
] ;END OF IFN ITS+D10
IFN D20,[
SKIPN -L.6DEV-L.6DIR-L.6FNM-L.6EXT-L.6VRS+1(FXP)
JRST 6BNS0A ;JUMP IF DEVICE NAME OMITTED
MOVEI TT,-L.6DEV-L.6DIR-L.6FNM-L.6EXT-L.6VRS+1(FXP)
] ;END OF IFN D20
PUSHJ P,6BTNS1
MOVEI TT,": ;9 OUT OF 10 OPERATING SYSTEMS AGREE:
IDPB TT,C ; ":" MEANS A DEVICE NAME.
6BNS0A:
;FOR ITS AND D20, DIRECTORY NAME COMES NEXT
IFN ITS,[
SKIPE TT,-2(FXP)
CAMN TT,[SIXBIT \*\]
JRST 6BTNS0 ;DIRECTORY NAME OMITTED
PUSHJ P,6BTNS1
MOVEI TT,"; ;";" MEANS DIRECTORY NAME TO ITS
IDPB TT,C
] ;END OF IFN ITS
IFN D20,[
SKIPN -L.6DIR-L.6FNM-L.6EXT-L.6VRS+1(FXP)
JRST 6BTNS0 ;DIRECTORY NAME OMITTED
MOVEI TT,"< ;D20 DIRECTORY NAME APPEARS IN <>
IDPB TT,C
MOVEI TT,-L.6DIR-L.6FNM-L.6EXT-L.6VRS+1(FXP)
PUSHJ P,6BTNS1
MOVEI TT,">
IDPB TT,C
] ;END OF IFN D20
6BTNS0:
;NOW WE ATTACK THE FILE NAME
20% MOVE TT,-1(FXP)
20$ MOVEI TT,-L.6FNM-L.6EXT-L.6VRS+1(FXP)
PUSHJ P,6BTNS1
;NOW THE FILE NAME 2/EXTENSION/TYPE
IFN ITS, MOVEI TT,40
IFN D10+D20, MOVEI TT,".
10$ SKIPE (FXP)
IDPB TT,C
IT$ MOVE TT,(FXP)
10$ HLLZ TT,(FXP)
20$ MOVEI TT,-L.6EXT-L.6VRS+1(FXP)
IT% SKIPE TT
PUSHJ P,6BTNS1
IFN D20,[
;FOR D20, THE VERSION/GENERATION COMES LAST
WARN [HOW TO DISTINGUISH NULL VERSION FROM *?]
SKIPN -L.6VRS+1(FXP)
JRST 6BTNS8
10X MOVEI TT,";
20X MOVEI TT,".
IDPB TT,C
MOVEI TT,-L.6VRS+1(FXP)
PUSHJ P,6BTNS1
] ;END OF IFN D20
IFN D10,[
;FOR D10, THE DIRECTORY COMES LAST
MOVE TT,-2(FXP)
CAME T,XC-1 ;FORGET IT IF BOTH HALVES OMITTED
SKIPL -6(P) ;NO DIRECTORY FOR SHORTNAMESTRING
JRST 6BTNS8
MOVEI TT,133 ;A LEFT BRACKET
IDPB TT,C
IFN CMU,[
HLRZ T,-2(FXP)
CAIG T,10 ;ONLY PROJECTS ABOVE 10 ARE IN CMU FORMAT
JRST 6BTNS4
PUSHN FXP,2 ;THERE IS A BUG IN DECCMU, BUT PUSHING ZERO WORDS
MOVEI T,-1(FXP) ; GETS US AROUND IT
HRLI T,-4(FXP)
DECCMU T,
JRST 6BTNS4 ;ON FAILURE, JUST USE DEC FORMAT
MOVEI T,-1(FXP)
TLOA T,440700
6BNS4A: IDPB TT,C ;COPY CHARACTERS INTO PNBUF
ILDB TT,T
JUMPN TT,6BNS4A
POPI FXP,2
JRST 6BTNS5
6BTNS4:
] ;END OF IFN CMU
HLLZ TT,-2(FXP)
PUSHJ P,6BTNS6 ;OUTPUT PROJECT
MOVEI TT,", ;COMMA SEPARATES HALVES
IDPB TT,C
HRLZ TT,-2(FXP)
PUSHJ P,6BTNS6 ;OUTPUT PROGRAMMER
6BTNS5: MOVEI TT,135 ;A RIGHT BRACKET
IDPB TT,C
] ;END OF IFN D10
6BTNS8: PUSHJ FXP,RDAEND ;FINISH OFF THE LAST WORD OF THE STRING
SETZM 1(C)
POPI FXP,L.F6BT ;POP CRUD OFF STACK
MOVEM C,-3(P) ;CROCK DUE TO SAVED AC C
POPJ P,
;;; COME HERE TO ADD A COMPONENT TO THE GROWING NAMESTRING IN PNBUF.
;;; FOR ITS AND D10, THE SIXBIT IS IN TT, AND MUST BE CONVERTED.
;;; FOR DEC20, TT HAS A POINTER TO THE ASCIZ STRING TO ADD.
6BTNS1:
IFN ITS+D10,[
SKIPN TT ;A ZERO WORD GETS OUTPUT AS "*"
MOVSI TT,(SIXBIT \*\)
6BTNS2: SETZ T,
LSHC T,6
JUMPE T,6BTNS3
10$ CAIE T,133-40 ;FOR DEC-10, BRACKETS MUST
10$ CAIN T,135-40 ; BE QUOTED
10$ JRST 6BTNS3
CAIE T,':
10% CAIN T,';
10$ CAIN T,'.
6BTNS3: IDPB R,C ;↑Q TO QUOTE FUNNY CHARS
ADDI T,40
IDPB T,C
JUMPN TT,6BTNS2
POPJ P,
] ;END OF IFN ITS+D10
IFN D20,[
SETZ D,
HRLI TT,440700
6BTNS2: ILDB T,TT
JUMPE T,CPOPJ
TRZE D,1 ;D IS THE PRECEDING-CHAR-WAS-↑V FLAG
JRST 6BTNS3
IRPC X,,[:;<>=←*@ ,] ;EVEN NUMBER OF GOODIES!
IFE .IRPCNT&1, CAIE T,"X
.ELSE,[
CAIN T,"X
IDPB R,C ;QUOTE FUNNY CHARACTER
] ;END OF .ELSE
TERMIN
IFN TOPS20,[ ;TOPS20 REQUIRES ADDITONAL CHARACTERS TO BE QUOTED
IRPC X,,[()[]{}/!"#%&'\|`↑}]
IFE .IRPCNT&1, CAIE T,"X
.ELSE,[
CAIN T,"X
IDPB R,C ;QUOTE FUNNY CHARACTER
] ;END OF .ELSE
TERMIN
] ;END OF IFN TOPS20
CAIN T,(R)
TRO D,1
6BTNS3: IDPB T,C
JRST 6BTNS2
] ;END OF IFN D20
IFN D10,[
;;; CONVERT ONE HALF OF A PPN, PUTTING ASCII CHARS IN PNBUF
6BTNS6: JUMPE TT,6BNS6A
CAME TT,[-1,,]
AOJA TT,6BTNS7 ;ADDING ONE PRODUCES A FLAG BIT
6BNS6A: MOVEI TT,"* ;AN OMITTED HALF IS OUTPUT AS "*"
IDPB TT,C
POPJ P,
6BNS7A: LSH TT,3+3*SAIL ;ZERO-SUPPRESS OCTAL (TOPS10/CMU), LEFT-JUSTIFY CHARS (SAIL)
6BTNS7: TLNN TT,770000←<3*<1-SAIL>>
JRST 6BNS7A ;NOTE THAT THE FLAG BIT GETS SHIFTED TOO
6BNS7B: SETZ T,
LSHC T,3+3*SAIL
SA% ADDI T,"0
SA$ ADDI T,40
IDPB T,C
TRNE TT,-1 ;WE'RE DONE WHEN THE FLAG BIT LEAVES THE RIGHT HALF
JRST 6BNS7B
POPJ P,
] ;END OF IFN D10
SUBTTL CONVERSION: NAMESTRING => SIXBIT
;;; THIS ONE IS PRETTY HAIRY. IT CONVERTS AN ATOMIC
;;; SYMBOL IN A, REPRESENTING A FILE SPECIFICATION,
;;; INTO "SIXBIT" FORMAT ON FXP. THIS INVOLVES
;;; PARSING A FILE NAME IN STANDARD ASCII STRING FORMAT
;;; AS DEFINED BY THE HOST OPERATING SYSTEM.
;;; FOR D20, THE OPERATING SYSTEM GIVES US SOME HELP.
;;; FOR ITS AND D10, WE ARE ON OUR OWN.
IFN ITS+D10,[
;;; THE GENERAL STRATEGY HERE IS TO CALL PRINTA TO EXPLODEC THE NAMESTRING.
;;; A PARSING COROUTINE TAKES THE SUCCESSIVE CHARACTERS AND INTERPRETS THEM.
;;; EACH COMPONENT IS ASSEMBLED IN SIXBIT FORM, AND WHEN IT IS TERMINATED
;;; BY A BREAK CHARACTER, IT IS PUT INTO ONE OF FOUR SLOTS RESERVED ON FXP.
;;; FOR CMU, WE ALSO ASSEMBLE THE CHARACTERS INTO PNBUF IN ASCII FORM,
;;; SO THAT WE CAN USE THE CMUDEC UUO TO CONVERT A CMU-STYLE PPN.
;;; AR1 HOLDS THE BYTE POINTER FOR ACCUMULATING A NAME.
;;; AR2A HOLDS MANY FLAGS DESCRIBING THE STATE OF THE PARSE:
NMS==:1,,525252 ;FOR BIT-TYPEOUT MODE
NMS.CQ==:1 ;CONTROL-Q SEEN
NMS.CA==:2 ;CONTROL-A SEEN
IFN D10,[
NMS.DV==:10 ;DEVICE SEEN (AND TERMINATING :)
NMS.FN==:20 ;FILE NAME SEEN
NMS.DT==:40 ;. SEEN
NMS.XT==:100 ;EXTENSION SEEN
NMS.LB==:200 ;LEFT BRACKET SEEN
NMS.CM==:400 ;COMMA SEEN
NMS.RB==:1000 ;RIGHT BRACKET SEEN
NMS.ND==:10000 ;NON-OCTAL-DIGIT SEEN
NMS.ST==:20000 ;* SEEN
] ;END OF IFN D10
;;; CONTROL-A IS THE SAIL CONVENTION FOR QUOTING MANY CHARACTERS, BUT WE
;;; ADOPT IT FOR ALL ITS AND D10 SYSTEMS.
NMS6B0: WTA [BAD NAMESTRING!]
NMS6BT: MOVEI TT,(A) ;DON'T ALLOW FIXNUMS AS NAMESTRINGS
LSH TT,-SEGLOG
MOVSI R,FX
TDNE R,ST(TT) ;A FIXNUM?
JRST NMS6B0 ;YES, ILLEGAL AS A NAMESTRING
PUSHN FXP,L.F6BT+1 ;FOUR WORDS FOR FINISHED NAMES, ONE FOR ACCUMULATION
MOVEI AR1,(FXP) ;AR1 HOLDS THE BYTE POINTER FOR ACCUMULATING A NAME
HRLI AR1,440600
SETZ AR2A, ;ALL FLAGS INITIALLY OFF
CMU$ PUSH FXP,PNBP ;FOR CMU, WE NEED THIS TO PARSE THE PPN
CMU$ SETZM PNBUF+LPNBUF-1
HRROI R,NMS6B1 .SEE PR.PRC
PUSH P,A
PUSHJ P,PRINTA ;PRINTA WILL CALL NMS6B1 WITH SUCCESSIVE CHARS IN A
TLNE AR2A,NMS.CA+NMS.CQ
JRST NMS6B0 ;ILLEGAL FOR A QUOTE TO BE HANGING
MOVEI A,40
PUSHJ P,(R) ;FORCE A SPACE THROUGH TO TERMINATE LAST COMPONENT
POP P,A
IFN D10,[
TLNE AR2A,NMS.LB
TLNE AR2A,NMS.RB
CAIA
JRST NMS6B0 ;LOSE IF LEFT BRACKET SEEN BUT NO RIGHT BRACKET
] ;END OF IFN D10
JUMPE AR1,NMS6B0 ;AR1 IS ZEROED IF THE PARSING CORUTINE DETECTS AN ERROR
POP FXP,1+CMU
MOVSI T,(SIXBIT \*\) ;CHANGE ANY ZERO COMPONENTS TO "*"
SKIPN -3(FXP)
MOVEM T,-3(FXP) ;DEVICE NAME
IT$ SKIPN -2(FXP)
IT$ MOVEM T,-2(FXP) ;SNAME
IFN D10,[
MOVE TT,-2(FXP) ;TREAT HALVES OF PPN SEPARATELY
TLNN TT,-1 ;A ZERO HALF BECOMES -1
TLO TT,-1
TRNN TT,-1
TRO TT,-1
MOVEM TT,-2(FXP)
] ;END OF IFN D10
SKIPN -1(FXP)
MOVEM T,-1(FXP) ;FILE NAME 1
SKIPN (FXP)
MOVEM T,(FXP) ;FILE NAME 2/EXTENSION
POPJ P,
;;; THIS IS THE NAMESTRING PARSING COROUTINE
NMS6B1: JUMPE AR1,CPOPJ ;ERROR HAS BEEN DETECTED, FORGET THIS CHARACTER
CAIN A,↑A
JRST NMS6BQ
CAIN A,↑Q
TLCE AR2A,NMS.CQ ;FOR A CONTROL-Q, SET THE CONTROL-Q BIT
CAIA ;IF IT WAS ALREADY SET, IT'S A QUOTED ↑Q
POPJ P, ;OTHERWISE EXIT
CAIN A,40 ;SPACE?
TLZN AR2A,NMS.CQ ;YES, QUOTED?
SKIPA ;NO TO EITHER TEST
JRST NMS6B9 ;YES TO BOTH, IS QUOTED SPACE
CAILE A,40 ;SKIP OF CONTROL CHARACTER OR SPACE
JRST NMS6B7
;WE HAVE ENCOUNTERED A BREAK CHARACTER - DECIDE WHAT TO DO WITH COMPONENT
NMS6B8: SKIPN D,(AR1)
POPJ P, ;NO CHARACTERS ASSEMBLED YET
IT$ SKIPN -2(AR1) ;IF WE HAVE A FILE NAME 1, THIS MUST BE FN2
10$ TLNN AR2A,NMS.DT ;WE HAVE SEEN A DOT, THIS MUST BE THE EXTENSION
JRST NMS6B5 ;OTHERWISE THIS IS FILE NAME 1
IT$ SKIPE -1(AR1) ;LOSE IF WE ALREADY HAVE A FILE NAME 2
10$ TLNE AR2A,NMS.XT+NMS.LB+NMS.CM+NMS.RB
JRST NMS6BL ;LOSE IF EXTENSION AFTER BRACKETS OR OTHER ONE
IT$ MOVEM D,-1(AR1)
10$ HLLZM D,-1(AR1)
10$ TLO AR2A,NMS.XT ;SET FLAG: WE'VE SEEN THE EXTENSION
;COME HERE TO RESTORE THE BYTE POINTER FOR THE NEXT COMPONENT
NMS6B6: JUMPE AR1,CPOPJ ;IF AN ERROR HAS BEEN DETECTED, EXIT
HRLI AR1,440600
CMU$ MOVE D,PNBP ;FOR CMU, RESET THE PNBUF BYTE POINTER ALSO
CMU$ MOVEM D,1(AR1)
10$ TLZ AR2A,NMS.ND+NMS.ST ;RESET NON-OCTAL-DIGIT AND STAR SEEN FLAGS
SETZM (AR1) ;CLEAR ACCUMULATION WORD
POPJ P,
;COME HERE FOR FILE NAME 1
NMS6B5:
10$ TLNE AR2A,NMS.FN+NMS.DT+NMS.XT+NMS.LB+NMS.CM+NMS.RB
10$ JRST NMS6BL ;LOSE IF TOO LATE FOR A FILE NAME
MOVEM D,-2(AR1) ;SAVE FILE NAME 1
JRST NMS6B6
;HERE WITH A NON-CONTROL NON-SPACE CHARACTER
NMS6B7: TLZN AR2A,NMS.CQ
TLNE AR1,NMS.CA
JRST NMS6B9 ;IF CHARACTER QUOTED (FOR ↑Q, FLAG IS RESET)
CAIN A,":
JRST NMS6DV ;: SIGNALS A DEVICE NAME
IT$ CAIN A,";
IT$ JRST NMS6SN ;; MEANS AN SNAME
IFN D10,[
CAIN A,".
JRST NMS6PD ;PERIOD MEANS TERMINATION OF FILE NAME
CAIN A,133
JRST NMS6LB ;LEFT BRACKET
CAIN A,",
JRST NMS6CM ;COMMA
CAIN A,135
JRST NMS6RB ;RIGHT BRACKET
CAIN A,"*
JRST NMS6ST ;STAR
] ;END OF IFN D10
;HERE TO DUMP A CHARACTER INTO THE ACCUMULATING COMPONENT
NMS6B9:
IFN CMU,[
SKIPE PNBUF+LPNBUF-1
TDZA AR1,AR1 ;ASSUME A COMPONENT THAT FILLS PNBUF IS A LOSER
IDPB A,1(AR1) ;STICK ASCII CHARACTER IN PNBUF
] ;END OF IFN CMU
IFN D10,[
CAIL A,"0
CAILE A,"7
TLO AR2A,NMS.ND ;SET FLAG IF NON-OCTAL-DIGIT
NMS6B4:
] ;END OF IFN D10
CAIGE A,140 ;CONVERT LOWER CASE TO UPPER,
SUBI A,40 ; AND ASCII TO SIXBIT
TLNE AR1,770000
IDPB A,AR1 ;DUMP CHARACTER INTO ACCUMULATING NAME
POPJ P,
NMS6BQ: TLCA AR2A,NMS.CA ;COMPLEMENT CONTROL-A FLAG
NMS6BL: SETZ AR1, ;ZEROING AR1 INDICATES A PARSE ERROR
POPJ P,
NMS6DV: SKIPE D,(AR1) ;ERROR IF : SEEN WITH NO PRECEDING COMPONENT
10$ ;ERROR AFTER OTHER CRUD
10$ TLNE AR2A,NMS.DV+NMS.FN+NMS.DT+NMS.XT+NMS.LB+NMS.CM+NMS.RB
10% SKIPE -4(AR1) ;ERROR IF DEVICE NAME ALREADY SEEN
JRST NMS6BL
MOVEM D,-4(AR1)
10$ TLO AR2A,NMS.DV
JRST NMS6B6 ;RESET BYTE POINTER
IFN ITS,[
NMS6SN: SKIPE D,(AR1) ;ERROR IF ; SEEN WITHOUT PRECEDING COMPONENT
SKIPE -3(AR1) ;ERROR IF WE ALREADY HAVE AN SNAME
JRST NMS6BL
MOVEM D,-3(AR1)
JRST NMS6B6 ;RESET BYTE POINTER
] ;END OF IFN ITS
IFN D10,[
NMS6PD: TLNE AR2A,NMS.DT+NMS.XT+NMS.LB+NMS.CM+NMS.RB
JRST NMS6BL
PUSHJ P,NMS6B8 ;DOT SEEN - SEE IF IT TERMINATED THE FILE NAME
TLO AR2A,NMS.DT ;SET PERIOD (DOT) FLAG
POPJ P,
NMS6LB: TLNE AR2A,NMS.LB+NMS.CM+NMS.RB
JRST NMS6BL ;LEFT BRACKET ERROR IF ALREADY A BRACKET
PUSHJ P,NMS6B8 ;DID WE TERMINATE THE FILE NAME OR EXTENSION?
TLO AR2A,NMS.LB ;SET LEFT BRACKET FLAG
NMS6L1:
SA% HRLI AR1,440300
SA$ HRLI AR1,440600
POPJ P,
NMS6CM: LDB D,[360600,,AR1]
CAIE D,44 ;ERROR IF NO CHARACTERS AFTER LEFT BRACKET
TLNN AR2A,NMS.LB ;ERROR IF NO LEFT BRACKET!
JRST NMS6BL
SA% TLNE AR2A,NMS.ND+NMS.CM+NMS.RB
SA$ TLNE AR2A,NMS.CM+NMS.RB
JRST NMS6BL ;ERROR IF NON-OCTAL-DIG, COMMA, OR RGT BRACKET
PUSHJ P,NMS6PP ;HACK HALF A PPN
HRLM D,-3(AR1)
TLO AR2A,NMS.CM ;SET COMMA FLAG
SETZM (AR1) ;CLEAR COLLECTING WORD
JRST NMS6L1 ;RESET BYTE POINTER
NMS6RB:
LDB D,[360600,,AR1]
CMU% TLNE AR2A,NMS.CM ;MUST HAVE COMMA BEFORE RIGHT BRACKET
CAIN D,44 ;ERROR IF NO CHARS SINCE COMMA/LEFT BRACKET
JRST NMS6BL
TLNE AR2A,NMS.LB ;ERROR IF NO LEFT BRACKET
TLNE AR2A,NMS.RB ;ERROR IF RIGHT BRACKET ALREADY SEEN
JRST NMS6BL
CMU$ TLNE AR2A,NMS.CM ;FOR CMU, NO COMMA MEANS A CMU-STYLE PPN
CMU$ JRST NMS6R1
PUSHJ P,NMS6PP ;FIGURE OUT HALF A PPN
HRRM D,-3(AR1)
NMS6R2: TLO AR2A,NMS.RB ;SET RIGHT BRACKET FLAG
JRST NMS6B6 ;RESET THE WORLD
IFN CMU,[
NMS6R1: MOVEI D,PNBUF
CMUDEC D, ;CONVERT CMU-STYLE PPN TO A WORD
JRST NMS6BL ;LOSE LOSE
MOVEM D,-3(AR1) ;WIN - SAVE IT AWAY
JRST NMS6R2
] ;END OF IFN CMU
NMS6ST: TLOE AR2A,NMS.ST ;SET STAR FLAG, SKIP IF NOT ALREADY SET
TLO AR2A,NMS.ND ;TWO STARS = A NON-DIGIT FOR PPN PURPOSES
JRST NMS6B4
NMS6PP:
SA% TLNE AR2A,NMS.ND
SA% SETZ AR1, ;NON-DIGIT IN PPN IS AN ERROR
HRRZI D,-1
TLNE AR2A,NMS.ST ;STAR => 777777
POPJ P,
LDB TT,[360600,,AR1]
CAIGE TT,22
SETZ AR1, ;MORE THAN SIX DIGITS LOSES
MOVNS TT
MOVE D,(AR1)
LSH D,(TT) ;RIGHT-JUSTIFY THE DIGITS
POPJ P,
] ;END OF IFN D10
] ;END OF IFN ITS+D10
IFN D20,[
;;; THE STRATEGY HERE IS TO USE GTJFN TO PARSE THE STRING,
;;; THEN GET THE VARIOUS COMPONENTS BACK SINGLY WITH JFNS.
NMS6B0: MOVE FXP,D ;D HAS SAVED FXP
PUSH FXP,F ;F HAS SAVED LOCKI WORD
UNLOCKI
%WTA (C)
NMS6BT: MOVEI C,[SIXBIT \FIXNUM ILLEGAL AS NAMESTRING\]
MOVEI TT,(A) ;DON'T ALLOW FIXNUMS AS NAMESTRINGS
LSH TT,-SEGLOG
MOVSI R,FX
TDNE R,FX ;A FIXNUM?
JRST NMS6B0 ;YES, ILLEGAL AS A NAMESTRING
LOCKI ;LOCK OUT INTERRUPTS (BECAUSE OF JSYS'S)
POP FXP,F ;POP LOCKI WORD
MOVE D,FXP ;SAVE LEVEL OF FXP
PUSHJ P,PNBFMK ;STRING OUT CHARACTERS INTO PNBUF
MOVEI C,[SIXBIT \NAMESTRING TOO LONG!\]
JUMPE AR2A,NMS6B0 ;LOSE IF DIDN'T FIT IN PNBUF
IDPB NIL,AR1 ;TERMINATE STRING WITH A NULL
MOVSI 1,(GJ%ACC+GJ%OFG+GJ%FLG+GJ%SHT)
MOVE 2,PNBP
WARN [I SUSPECT THAT TO DO OMITTED NAMES RIGHT WE MAY NEED A LONG GTJFN]
GTJFN ;GET A JFN FOR PARSED NAMESTRING
IOJRST 0,NMS6B0
PUSH FXP,F ;PUSH BACK LOCKI WORD
TDZA R,R ;R=0 => NMS6BT
JFN6BT: MOVEI R,1 ;CONVERT JFN IN 1 TO "SIXBIT" ON FXP
POP FXP,F ;POP LOCKI WORD (COME IN LOCKED, EXIT UNLOCKED)
MOVE D,FXP .SEE TRUENAME ;SAVES T, SKIP RETURN ON FAILURE
MOVE 2,1
MOVSI 3,.JSAOF←17 .SEE JS%DEV JS%DIR JS%NAM JS%TYP JS%GEN
IRP LEN,,[L.6DEV,L.6DIR,L.6FNM,L.6EXT,L.6VRS]10XFLD,,[DEVICE,DIRECTORY,NAME,EXTENSION
VERSION]20XFLD,,[DEVICE,DIRECTORY,NAME,TYPE,GENERATION]FLAG,,[1,0,0,0,0]
SETZM PNBUF
MOVE T,[PNBUF,,PNBUF+1]
BLT T,PNBUF+LEN-1 ;CLEAR OUT PNBUF
MOVE 1,PNBP
PUSH P,3 ;SAVE FLAGS OVER CALL
JFNS ;GET ASCII STRING FOR NEXT COMPONENT IN PNBUF
IFN FLAG, ERJMP JFN6ER ;IF ERROR THEN TRY DEVST
10X MOVEI C,[SIXBIT \10XFLD FIELD TOO LONG!\]
20X MOVEI C,[SIXBIT \20XFLD FIELD TOO LONG!\]
LDB T,[010700,,PNBUF+LEN-1]
JUMPN T,NMS6B7
POP P,3
DPB NIL,[010700,,PNBUF+LEN-1]
REPEAT LEN, PUSH FXP,PNBUF+.RPCNT
LSH 3,-3 .SEE JS%DEV JS%DIR JS%NAM JS%TYP JS%GEN
TERMIN
NMS6BZ: JUMPN R,NMS6B2
MOVEI 1,(2)
RLJFN ;RELEASE THE JFN FOR NMS6BT
HALT
NMS6B2: PUSH FXP,F ;PUSH LOCKI WORD BACK
UNLKPOPJ
JFN6ER: CAIE 2,.PRIIN ;PRIMARY INPUT?
CAIN 2,.PRIOU ;OR PRIMARY OUTPUT
SKIPA ;YES
JRST NMS6B7 ;NOPE, FAIL
PUSH FXP,[ASCII/PRIMA/]
PUSH FXP,[ASCIZ/RY/]
REPEAT <L.6DEV-2>+L.6DIR+L.6FNM+L.6EXT+L.6VRS, PUSH FXP,R70
POPI P,1
JRST NMS6BZ
NMS6B7: POPI P,1
JUMPE R,NMS6B0 ;FOR NMS6BT, GO GIVE WTA ERROR
AOS (P) ;FOR JFN6BT, SKIP ON FAILURE
MOVE FXP,D ; WITH NO CRUD ON FXP AT ALL
JRST NMS6B2
] ;END OF IFN D20
SUBTTL CONVERSION: ANY FILE SPEC => SIXBIT
;;; TAKE ARGUMENT IN A (MAY BE FILE ARRAY, NAMELIST,
;;; OR NAMESTRING), FIGURE IT OUT AND SOMEHOW RETURN
;;; "SIXBIT" FORMAT ON FXP.
;;; IFL6BT SAYS THAT T MEANS TTY INPUT, NOT TTY OUTPUT.
;;; SAVES C AR1 AR2A
IFL6BT: CAIN A,TRUTH
HRRZ A,V%TYI
JRST FIL6B0
IFN SFA,[
FILSFA: MOVEI B,QNAME ;EXTRACT THE "FILENAME" FROM THE SFA
SETZ C, ;NO ARGS
PUSHJ P,ISTCSH ;SHORT CALL, THEN USE RESULT AS NEW NAME
] ;END IFN SFA
FIL6BT: CAIN A,TRUTH
HRRZ A,V%TYO
FIL6B0: SKIPN A ;NIL => DEFAULTS
HRRZ A,VDEFAULTF
FIL6B1: MOVEI R,(A)
LSH R,-SEGLOG
SKIPGE R,ST(R)
JRST NML6BT ;LIST => NAMELIST
TLNN R,SA
JRST FIL6B2 ;NOT ARRAY => NAMESTRING
MOVE R,ASAR(A)
SFA$ TLNE R,AS.SFA ;AN SFA?
SFA$ JRST FILSFA ;YES, EXTRACT NAME FROM IT AND TRY AGAIN
TLNN R,AS<JOB+FIL>
JRST NMS6B0 ;INCOMPREHENSIBLE NAMESTRING
LOCKI ;FOR FILE, GOBBLE NAMES OUT OF FILE OBJECT
POP FXP,D ;POP LOCKI WORD
MOVE TT,TTSAR(A)
ADDI TT,F.DEV
HRLI TT,-L.F6BT
PUSH FXP,(TT) ;PUSH ALL WORDS OF FILE SPEC
AOBJN TT,.-1
PUSH FXP,D ;PUSH BACK LOCKI WORD
UNLKPOPJ ;UNLOCK AND EXIT
FIL6B2: JSP T,QIOSAV
JRST NMS6BT
QIOSAV: SAVE B C AR1 AR2A
PUSHJ P,(T)
RSTR AR2A AR1 C B
POPJ P,
.SEE 6BTNS8 ;RELIES ON AC C BEING SAVED IN CERTAIN SPOT
SUBTTL MERGING ROUTINES, MERGEF, TRUENAME, PROBEF
;;; MERGEF TAKES TWO FILE SPECS OF ANY KIND, MERGES THEM,
;;; AND RETURNS A NAMELIST OF THE RESULTING SPECS.
;;; AS A CROCK, (MERGEF X '*) SIMPLY MAKES THE SECOND
;;; FILE NAME (FOR D20, THE VERSION) BE *.
MERGEF: PUSH P,B
PUSHJ P,FIL6BT
POP P,A
CAIE A,Q.
JRST MRGF1
20% MOVSI T,(SIXBIT \*\)
20% MOVEM T,(FXP)
20$ REPEAT L.6VRS, SETZM -.RPCNT(FXP)
JRST 6BTNML
MRGF1: PUSHJ P,FIL6BT
PUSHJ P,IMRGF
JRST 6BTNML
;;; IMRGF MERGES TWO SETS OF SPECS ON THE FIXNUM PDL.
;;; DMRGF MERGES A SET WITH THE DEFAULT FILE NAMES.
;;; DEC-10 PPN'S MERGE HALVES OF THE PPN SEPARATELY;
;;; AN UNSPECIFIED HALF IS -1 OR 0, *NOT* (SIXBIT \*\)!!
;;; SAVES F (SEE LOAD).
DMRGF:
;FIRST SEE WHETHER WE REALLY NEED TO CONVERT THE DEFAULTS TO "SIXBIT"
IFN ITS+D10,[
MOVSI TT,(SIXBIT \*\)
REPEAT L.F6BT,[
IFN ITS\<.RPCNT-1>,[
CAME TT,.RPCNT-3(FXP) ;MUST MERGE IF FILE NAME IS ZERO OR *
SKIPN .RPCNT-3(FXP)
JRST DMRGF5
] ;END OF IFN ITS\<.RPCNT-1>
.ELSE,[
MOVE T,.RPCNT-3(FXP)
TLCE T,-1
TLNN T,-1
JRST DMRGF5
TRCE T,-1
TRNN T,-1
JRST DMRGF5
] ;END OF .ELSE
] ;END OF REPEAT L.F6BT
] ;END OF IFN ITS+D10
IFN D20,[
MOVSI TT,(ASCII \*\)
ZZZ==0
IRP FOO,,[L.6VRS,L.6EXT,L.6FNM,L.6DIR,L.6DEV]
ZZZ==ZZZ+FOO
CAME TT,-ZZZ+1(FXP)
SKIPN -ZZZ+1(FXP)
JRST DMRGF5
TERMIN
EXPUNGE ZZZ
] ;END OF IFN D20
POPJ P, ;MERGE WOULDN'T DO ANYTHING - FORGET IT
DMRGF5: PUSH FLP,F ;MERGE WITH DEFAULT FILE NAMES
HRRZ A,VDEFAULTF
PUSHJ P,FIL6BT
POP FLP,F
IMRGF:
IFN ITS+D10,[
MOVEI T,L.F6BT ;MERGE TWO SETS OF NAMES ON FXP
MOVSI TT,(SIXBIT \*\)
MRGF2:
10$ MOVE R,D
POP FXP,D
10$ CAIE T,2 ;PPN IS PENULTIMATE FROB - DON'T COMPARE TO *
CAME TT,-3(FXP)
SKIPN -3(FXP)
MOVEM D,-3(FXP)
SOJG T,MRGF2
10$ MOVE D,-2(FXP) ;R HAS PPN 2 - GET PPN 1 IN D
10$ TLCE D,-1 ;IF 0
10$ TLNN D,-1 ;OR -1
10$ HLLM R,-2(FXP) ;DEFAULT
10$ TRCE D,-1
10$ TRNN D,-1
10$ HRRM R,-2(FXP)
] ;END OF IFN ITS+D10
IFN D20,[
MOVSI TT,(ASCII \*\)
IRP FOO,,[VRS,EXT,FNM,DIR,DEV]
CAME TT,-L.6!FOO-L.F6BT+1(FXP)
SKIPN -L.6!FOO-L.F6BT+1(FXP)
JRST IM!FOO!1
POPI FXP,L.6!FOO
JRST IM!FOO!2
IM!FOO!1:
IFLE L.6!FOO-3, REPEAT L.6!FOO, POP FXP,-L.F6BT(FXP)
.ELSE,[
MOVEI T,L.6!FOO
POP FXP,-L.F6BT(FXP)
SOJG T,.-1
] ;END OF .ELSE
IM!FOO!2:
TERMIN
] ;END OF IFN D20
C6BTNML: POPJ P,6BTNML
;;; (TRUENAME <FILE>) RETURNS THE RESULT OF .RCHST ON ITS,
;;; I.E. THE REAL FILE NAMES AFTER TRANSLATIONS, LINKS, ETC.
;;; THE RESULT IS A NAMELIST.
TRUENAME:
IFN SFA,[
EXCH AR1,A
JSP TT,XFOSP ;FILE OR SFA OR NOT?
JRST TRUNM9 ;NOT
JRST TRUNMZ ;FILE
EXCH A,AR1
JSP T,QIOSAV
MOVEI B,QTRUENAME
SETZ C, ;NO THIRD ARG
JRST ISTCSH ;SHORTY INTERNAL STREAM CALL
TRUNMZ: EXCH A,AR1
] ;END IFN SFA
PUSH P,C6BTNML ;SUBR 1
TRU6BT: CAIN A,TRUTH
HRRZ A,V%TYO
TRUNM2: EXCH AR1,A
LOCKI
JSP TT,XFILEP
JRST TRUNM8
MOVE TT,TTSAR(AR1) ;REST OF ROUTINE NEEDS TTSAR IN TT
EXCH AR1,A
IFN ITS+D10,[
POP FXP,T ;POP LOCKI WORD
REPEAT L.F6BT, PUSH FXP,F.RDEV+.RPCNT(TT)
PUSH FXP,T
UNLKPOPJ
] ;END OF ITS+D10
IFN D20,[
PUSH P,A ;GC PROTECT THE ARGUMENT
MOVE 1,F.JFN(TT)
PUSHJ P,JFN6BT ;GET "SIXBIT" ON FXP, AND UNLOCKI
JRST POPAJ
] ;END OF IFN D20
TRUNM8: UNLOCKI
TRUNM9: EXCH AR1,A
%WTA NFILE ;NOT FILE
SFA$ MOVE T,C6BTNML ;IF NOT CALLED AS A SUBR, ONLY ACCEPT A FILE
SFA$ CAME T,(P)
JRST TRUNM2
SFA$ POPI P,1
SFA$ JRST TRUENAME
;;; (STATUS UREAD)
SUREAD: SKIPN A,VUREAD
POPJ P,
PUSHJ P,TRUENAME
HLRZ B,(A)
HRRZ A,(A)
HRRZ C,(A)
20$ HRRZ C,(C)
20$ HRRM C,(A)
HRRM B,(C)
POPJ P,
;;; (STATUS UWRITE)
SUWRITE: SKIPE A,VUWRITE
PUSHJ P,TRUENAME
JRST $CAR ;(CAR NIL) => NIL
;;; ROUTINE TO SET UP ARGS FOR TWO-ARGUMENT FILE FUNCTION.
;;; PUT TWO SETS OF FILE NAMES ON FXP. IF THE ARGS ARE
;;; X AND Y, THEN THE NAMES ON FXP ARE (MERGEF X NIL) AND
;;; (MERGEF Y (MERGEF X NIL)). THE FIRST ARG IS LEFT IN AR1.
2MERGE: PUSH P,A
PUSH P,B
PUSHJ P,FIL6BT
PUSHJ P,DMRGF
POP P,A
PUSHJ P,FIL6BT
MOVEI T,L.F6BT
PUSH FXP,-2*L.F6BT+1(FXP)
SOJG T,.-1
PUSHJ P,IMRGF ;NOW WE HAVE THE MERGED FILE SPECS
POP P,AR1 ;FIRST ARG
POPJ P,
;;; (PROBEF X) TRIES TO DECIDE WHETHER FILE X EXISTS.
;;; ON ITS AND D10 THIS IS DONE BY TRYING TO OPEN THE FILE.
;;; ON D20 WE USE THE GTJFN JSYS.
;;; RETURNS REAL FILE NAMES ON SUCCESS, NIL ON FAILURE.
PROBEF: ;SUBR 1
IFN SFA,[
JSP TT,AFOSP ;DO WE HAVE AN SFA?
JRST PROBEZ ;NOPE
JRST PROBEZ ;NOPE
MOVEI B,QPROBEF ;PROBEF OPERATION
SETZ C, ;NO ARGS
JRST ISTCSH ;SHORT CALL, RETURN RESULTS
PROBEZ: ] ;END IFN SFA
PUSHJ P,FIL6BT
PROBF0: PUSHJ P,DMRGF
IFN ITS,[
LOCKI
SETZ TT, ;ASSUME NO CONTROL ARG
MOVSI T,'USR ;CHECK FOR USR DEVICE
CAMN T,-3-1(FXP) ;MATCH?
TRO TT,10 ;SET BIT 1.4 (INSIST ON EXISTING JOB)
.CALL PROBF8
JRST PROBF6
.CALL PROBF9
.LOSE 1400
.CLOSE TMPC,
UNLOCKI
] ;END OF IFN ITS
IFN D10,[
LOCKI
MOVEI T,.IODMP ;I/O MODE (DUMP MODE)
MOVE TT,-3-1(FXP) ;DEVICE NAME
SETZ D,
OPEN TMPC,T
JRST PROBF6 ;NO SUCH FILE IF NO SUCH DEVICE!
IFE SAIL,[
MOVEI T,3 ;ONLY NEED 3 ARGS OF EXTENDED LOOKUP
MOVE D,-1-1(FXP) ;FILE NAME
HLLZ R,0-1(FXP) ;EXTENSION
MOVE TT,-2-1(FXP) ;PPN
] ;END IFE SAIL
IFN SAIL,[
MOVE T,-1-1(FXP) ;FILE NAME
HLLZ TT,0-1(FXP) ;EXTENSION
PUSHJ P,SAEXT
SETZ D, ;UNUSED
MOVE R,-2-1(FXP) ;PPN
] ;END IFN SAIL
LOOKUP TMPC,T
JRST PROBF5 ;FILE DOESN'T EXIST
PUSHJ P,D10RFN ;READ BACK FILE NAMES
RELEASE TMPC, ;RELEASE TEMP CHANNEL
UNLOCKI
JRST 6BTNML ;FORM NAMELIST ON SUCCESS
D10RFN: MOVEI F,TMPC ;WE WILL GET DEVICE NAME FROM MONITOR
SA% DEVNAM F,
SA$ PNAME F,
SKIPA ;NONE SO RETAIN OLD NAME
MOVEM F,-3-1(FXP) ;ELSE STORE NEW DEVICE NAME
IFE SAIL,[
MOVEM TT,-2-1(FXP) ;STORE DATA AS RETURNED FROM EXTENDED LOOKUP
MOVEM D,-1-1(FXP)
HLLZM R,0-1(FXP)
] ;END IFE SAIL
IFN SAIL,[
MOVEM T,-1-1(FXP) ;SAIL HAS NO EXTENDED LOOKUP!!!!!
HLLZM TT,0-1(FXP) ; SO, WE CAN'T STORE PPN; JUST ASSUME IT IS
; WHAT WE GAVE IT
] ;END IFN SAIL
POPJ P,
] ;END OF IFN D10
IFN D20,[
PUSHJ P,6BTNS ;GET NAMESTRING IN PNBUF
LOCKI
MOVSI 1,(GJ%OLD+GJ%ACC+GJ%SHT) .SEE .GJDEF
MOVE 2,PNBP
GTJFN ;GET A JFN (INSIST ON EXISTING FILE)
JRST UNLKFALSE
PUSH FLP,1 ;SAVEE JFN OVER JFN6BT
PUSHJ P,JFN6BT ;CONVERT JFN TO "SIXBIT" FORMAT ON FXP
POP FLP,1
RLJFN ;RELEASE THE JFN
HALT
] ;END OF IFN D20
10% JRST 6BTNML
IFN ITS+D10,[
10$ PROBF5: RELEASE TMPC,
PROBF6: UNLOCKI
POPI FXP,L.F6BT ;POP "SIXBIT" CRUD FROM FXP
JRST FALSE ;RETURN FALSE ON FAILURE
] ;END OF IFN ITS+D10
IFN ITS,[
PROBF8: SETZ
SIXBIT \OPEN\ ;OPEN FILE (ASCII UNIT INPUT)
4000,,TT ;CONTROL ARG (DON'T CREATE BIT SET FOR USR)
1000,,TMPC ;CHANNEL #
,,-3-1(FXP) ;DEVICE NAME
,,-1-1(FXP) ;FILE NAME 1
,,0-1(FXP) ;FILE NAME 2
400000,,-2-1(FXP) ;SNAME
PROBF9: SETZ
SIXBIT \RFNAME\ ;READ REAL FILE NAMES
1000,,TMPC ;CHANNEL #
2000,,-3-1(FXP) ;DEVICE NAME
2000,,-1-1(FXP) ;FILE NAME 1
2000,,0-1(FXP) ;FILE NAME 2
402000,,-2-1(FXP) ;SNAME
] ;END OF IFN ITS
SUBTTL RENAMEF FUNCTION, CNAMEF FUNCTION
;;; (RENAMEF X Y) RENAMES (MERGEF X (NAMELIST NIL)) TO BE
;;; (MERGEF Y (MERGEF X (NAMELIST NIL))).
;;; IF X IS AN OUTPUT FILE ARRAY, IT IS RENAMED AND CLOSED.
$RENAMEF:
PUSHJ P,2MERGE ;2MERGE LEAVES ARG 1 IN AR1
JSP TT,XFILEP ;SKIP IF FILE ARRAY
JRST RENAM2
MOVE TT,TTSAR(AR1)
TLNE TT,TTS.CL
JRST RENAM2
HLLOS NOQUIT
MOVEI A,(AR1)
IFN ITS,[
.CALL RENAM7 ;MUST RENAME WHILE OPEN
IOJRST 0,RENAM6
] ;END OF IFN ITS
PUSHJ P,JCLOSE ;RETURNS CHANNEL IN T, TTSAR IN TT
IFN D10,[
MOVE F,F.CHAN(TT)
MOVE T,-1(FXP)
HLLZ TT,(FXP)
SETZ D,
MOVE R,-2(FXP)
LSH F,27
IOR F,[RENAME 0,T]
XCT F
IOJRST 0,RENAM6
SA$ XOR F,[<CLOSE 0,0>#<RENAME 0,T>]
SA$ XCT F
SA$ XOR F,[<RELEASE 0,0>#<CLOSE 0,0>]
SA% XOR F,[<RELEASE 0,0>#<RENAME 0,T>]
XCT F
] ;END OF IFN D10
IFN D20,[
PUSH P,F.JFN(TT)
RENAM0: PUSH P,[-1]
PUSHJ P,X6BTNS
POPI P,1
POP P,T
MOVSI 1,(GJ%FOU+GJ%NEW+GJ%ACC+GJ%SHT)
MOVE 2,PNBP
GTJFN
IOJRST 0,RENAM5
MOVE 2,1
MOVE 1,T
HRLI 1,(CO%NRJ)
CLOSF
IOJRST 0,RENAM4
TLZ 1,-1
RNAMF
IOJRST 0,RENAM4
MOVE 1,2
RLJFN ;? SHOULD GC DO THE RELEASE?
HALT
] ;END OF IFN D20
IFN ITS+D10,[
MOVE F,-1(FXP) ;UPDATE THE FILE NAMES
MOVEM F,F.FN1(TT)
10$ MOVEM F,F.RFN1(TT)
IT$ MOVE F,(FXP)
10$ HLLZ F,(FXP)
MOVEM F,F.FN2(TT)
10$ MOVEM F,F.RFN2(TT)
10$ MOVE F,-2(FXP)
10$ MOVEM F,F.PPN(TT)
10$ MOVEM F,F.RPPN(TT)
IT$ .CALL RFNAME ;READ BACK THE TRUENAMES
IT$ .LOSE 1400 ;END OF IFN ITS+D10
IT$ .CALL CLOSE9
IT$ .LOSE 1400
] ;END OF IFN ITS+D10
IFN D20,[
MOVEI T,F.DEV(TT)
HRLI T,-L.F6BT+1(FXP)
BLT T,F.DEV+L.F6BT-1(TT)
] ;END OF IFN D20
PUSHJ P,CZECHI
POPI FXP,L.F6BT
20$ JUMPE AR1,RENAM3
MOVEI A,(AR1)
RENAM1: POPI FXP,L.F6BT
POPJ P,
RENAM2:
IFN ITS,[
.CALL RENAM8 ;ORDINARY RENAME
IOJRST 0,RENAM9
] ;END OF IFN ITS
IFN D10,[
MOVEI T,.IODMP ;TO RENAME A FILE, WE OPEN A DUMP MODE CHANNEL
MOVE TT,-7(FXP) ;GET DEVICE NAME
SETZ D,
OPEN TMPC,T ;OPEN CHANNEL
JRST RENAM4
MOVE T,-5(FXP) ;FILE NAME
HLLZ TT,-4(FXP) ;EXTENSION
SA$ PUSHJ P,SAEXT
SETZ D,
MOVE R,-6(FXP) ;PPN
LOOKUP TMPC,T ;LOOK UP FILE
IOJRST 0,RENAM5
MOVE T,-1(FXP) ;NEW FILE NAME
HLLZ TT,(FXP) ;NEW EXTENSION
SETZ D,
MOVE R,-2(FXP) ;NEW PPN
RENAME TMPC,T ;RENAME FILE
IOJRST 0,RENAM5
RELEASE TMPC,
] ;END OF IFN D10
IFN D20,[
MOVEI T,L.F6BT
PUSH FXP,-2*L.F6BT+1(FXP) ;COPY OLD FILE NAMES TO TOP OF FXP
SOJG T,.-1
PUSH P,[-1] ;FLAG SAYING LONG NAMESTRING
PUSHJ P,6BTNS ;STRING OUT INTO PNBUF
POPI P,1
MOVE 2,PNBP
GTJFN ;GET A JFN FOR OLD FILE NAMES
IOJRST 0,RENAM6
PUSH P,1
SETZ AR1, ;GO RENAME THE FILE, RETURNING TO RENAM3
JRST RENAM0
RENAM3:
] ;END OF IFN D20
PUSHJ P,6BTNML ;RETURN VALUE IS NAMELIST
JRST RENAM1
IFN ITS,[
RENAM7: SETZ
SIXBIT \RENMWO\ ;RENAME WHILE OPEN
,,F.CHAN(TT) ;CHANNEL #
,,-1(FXP) ;NEW FILE NAME 1
400000,,(FXP) ;NEW FILE NAME 2
RENAM8: SETZ
SIXBIT \RENAME\ ;RENAME
,,-7(FXP) ;DEVICE NAME
,,-5(FXP) ;OLD FILE NAME 1
,,-4(FXP) ;OLD FILE NAME 2
,,-6(FXP) ;SNAME
,,-1(FXP) ;NEW FILE NAME 1
400000,,(FXP) ;NEW FILE NAME 2
] ;END OF IFN ITS
IFN D20,[
RENAM4: RLJFN ? WARN [ARE AC'S OKAY HERE?]
HALT
RENAM5: MOVE 1,T
RLJFN
HALT
] ;END OF IFN D20
IFN D10,[
RENAM4: SKIPA C,[NSDERR]
RENAM5: RELEASE TMPC,
] ;END OF IFN D10
RENAM6: PUSHJ P,CZECHI
RENAM9: PUSHJ P,6BTNML ;ERROR MESSAGE IS IN C
PUSHJ P,NCONS
PUSH P,A
PUSHJ P,6BTNML
POP P,B
PUSHJ P,CONS
MOVEI B,Q$RENAMEF
XCIOL: PUSHJ P,XCONS ;XCONS, THEN IOL
%IOL (C)
10$ NSDERR: SIXBIT \NO SUCH DEVICE!\
IFN ITS,[
RFNAME: SETZ
SIXBIT \RFNAME\ ;READ FILE NAMES
,,F.CHAN(TT) ;CHANNEL #
2000,,F.RDEV(TT) ;DEVICE NAME
2000,,F.RFN1(TT) ;FILE NAME 1
2000,,F.RFN2(TT) ;FILE NAME 2
402000,,F.RSNM(TT) ;SNAME
] ;END OF IFN ITS
CNAMEF: PUSHJ P,2MERGE ;LEAVES FIRST ARG IN AR1
JSP TT,XFILEP
JRST CNAME1
MOVE TT,TTSAR(AR1)
TLNN TT,TTS.CL ;FILE-ARRAY MUST BE CLOSED
JRST CNAME2
ADDI TT,L.F6BT
MOVEI F,L.F6BT ;COUNTER TO TRANSFER WORDS
CNAME3: MOVE T,(FXP)
MOVEM T,F.DEV-1(TT)
20% POP FXP,F.RDEV-1(TT)
SUBI TT,1
SOJG F,CNAME3
POPI FXP,L.F6BT
20$ POPI FXP,L.F6BT
MOVEI A,(AR1)
POPJ P,
CNAME2: SKIPA C,[CNAER2]
CNAME1: MOVEI C,CNAER1
CNAMER: PUSHJ P,6BTNML ;ERROR MESSAGE IS IN C
PUSHJ P,NCONS
PUSH P,A
PUSHJ P,6BTNML
POP P,B
PUSHJ P,CONS
MOVEI B,QCNAMEF
PUSHJ P,XCONS ;XCONS, THEN IOL
%IOL (C)
CNAER1: SIXBIT/NOT FILE ARRAY!/
CNAER2: SIXBIT/FILE ARRAY NOT CLOSED!/
SUBTTL DELETEF FUNCTION
;;; (DELETEF X) DELETES THE FILE X. (THAT SOUNDS LOGICAL...)
$DELETEF: ;SUBR 1
JSP TT,AFOSP ;SKIP IF FILE OR SFA
JRST $DEL3
IFN SFA,[
JRST $DELNS ;A FILE, NOT AN SFA
MOVEI B,Q$DELETE ;DELETE OPERATION
SETZ C, ;NO OP SPECIFIC ARG
JRST ISTCSH ;FAST INTERNAL SFA CALL
$DELNS: ] ;END IFN SFA
MOVE TT,TTSAR(A)
TLNE TT,TTS.CL ;SKIP IF OPEN
JRST $DEL3
HLLOS NOQUIT
IFN ITS,[
.CALL $DEL6 ;USE DELEWO FOR AN OPEN FILE
IOJRST 0,$DEL9A
PUSHJ P,JCLOSE
MOVE T,F.CHAN(TT) ;CHANNEL INTO T FOR CLOSE9
.CALL CLOSE9 ;ACTUALLY PERFORM THE CLOSE
.LOSE 1400
] ;END OF IFN ITS
IFN D10,[
MOVE F,F.CHAN(TT)
MOVE R,F.RPPN(TT)
LSH F,27
IOR F,[RENAME 0,T]
SETZB T,TT
XCT F
IOJRST 0,$DEL9A
PUSHJ P,JCLOSE
XOR F,[<CLOSE 0,40>#<RENAME 0,T>]
XCT F ;40 BIT MEANS AVOID SUPERSEDING A FILE
XOR F,[<RELEASE 0,0>#<CLOSE 0,40>]
XCT F
] ;END OF IFN D10
IFN D20,[
HRRZ 1,F.JFN(TT)
HRLI 1,(CO%NRJ) ;DON'T RELEASE JFN
PUSHJ P,JCLOSE
CLOSF
IOJRST 0,$DEL9A
TLZ 1,-1
DELF
IOJRST 0,$DEL9A
] ;END OF IFN D20
JRST CZECHI
IFN ITS,[
$DEL6: SETZ
SIXBIT \DELEWO\ ;DELETE WHILE OPEN
400000,,F.CHAN(TT) ;CHANNEL #
] ;END OF IFN ITS
$DEL3: PUSHJ P,FIL6BT
PUSHJ P,DMRGF ;MERGE ARG WITH DEFAULTS
IFN ITS,[
.CALL $DEL7
IOJRST 0,$DEL9
] ;END OF IFN ITS
IFN D10,[
MOVEI T,.IODMP
MOVE TT,-3(FXP) ;GET DEVICE NAME
SETZ D,
OPEN TMPC,T ;OPEN TEMP DUMP MODE CHANNEL
JRST $DEL4
MOVE T,-1(FXP) ;FILE NAME
HLLZ TT,(FXP) ;EXTENSION
SA$ PUSHJ P,SAEXT
SETZ D,
MOVE R,-2(FXP) ;PPN
LOOKUP TMPC,T
IOJRST 0,$DEL5
SETZB T,TT ;ZERO FILE NAMES MEANS DELETE
MOVE R,-2(FXP) ;MUST SPECIFY CORRECT PPN
RENAME TMPC,T ;DELETE THE FILE
IOJRST 0,$DEL5
RELEASE TMPC, ;RELEASE TEMP CHANNEL
] ;END OF IFN D10
IFN D20,[
PUSH P,[-1] ;SAY LONG NAMESTRING
PUSHJ P,X6BTNS ;GET NAMESTRING FOR FILE IN PNBUF
POPI P,1
MOVE 1,[GJ%OLD+GJ%ACC+GJ%SHT+.GJLEG]
MOVE 2,PNBP
GTJFN ;GET A JFN FOR THE FILE
IOJRST 0,$DEL9
TLZ 1,-1
DELF ;DELETE IT
IOJRST 0,$DEL5
] ;END OF IFN D20
JRST 6BTNML
IFN ITS,[
$DEL7: SETZ
SIXBIT \DELETE\ ;DELETE FILE
,,-3(FXP) ;DEVICE NAME
,,-1(FXP) ;FILE NAME 1
,,0(FXP) ;FILE NAME 2
400000,,-2(FXP) ;SNAME
] ;END OF IFN ITS
IFN D20,[
$DEL5: RLJFN ;RELEASE THE TEMP JFN
HALT
] ;END OF IFN D20
IFN D10,[
$DEL4: SKIPA C,[NSDERR]
$DEL5: RELEASE TMPC, ;RELEASE THE TEMP CHANNEL
] ;END OF IFN D10
$DEL9: PUSHJ P,6BTNML
$DEL9A: PUSHJ P,CZECHI
PUSHJ P,ACONS
MOVEI B,Q$DELETEF
JRST XCIOL
SUBTTL CLOSE FUNCTION
;;; (CLOSE X) CLOSES THE FILE ARRAY X. THE ARRAY ITSELF
;;; IS *NOT* FLUSHED - MAY WANT TO RE-OPEN IT.
CLOSE0:
SFA% WTA [NOT FILE - CLOSE!]
SFA$ WTA [NOT FILE OR SFA - CLOSE!]
$CLOSE: JSP TT,AFOSP ;LEAVES OBJECT IN A
JRST CLOSE0 ;NOT A FILE
IFN SFA,[
JRST ICLOSE ;A FILE-ARRAY, DO INTERNAL STUFF
MOVEI B,Q$CLOSE ;CLOSE OPERATION
SETZ C, ;NO THIRD ARG
JRST ISTCSH ;SHORT INTERNAL SFA CALL
] ;END IFN SFA
ICLOSE: HLLOS NOQUIT
MOVE TT,TTSAR(A)
TLNE TT,TTS.CL
JRST ICLOS6
PUSHJ P,JCLOSE
IFN ITS,[
.CALL CLOSE9 ;CLOSE FILE
.LOSE 1400
] ;END OF IFN ITS
IFN D10,[
LSH T,27
SA$ IOR T,[CLOSE 0,0]
SA$ XCT T
SA$ XOR T,[<RELEASE 0,0>#<CLOSE 0,0>]
SA% IOR T,[RELEASE 0,0]
XCT T
] ;END OF IFN D10
IFN D20,[
HRRZ 1,F.JFN(TT)
CLOSF ;DOES AN IMPLICIT RLJFN
JFCL
] ;END OF IFN D20
SKIPA A,[TRUTH] ;RETURN T IF DID SOMETHING, ELSE NIL
ICLOS6: MOVEI A,NIL
JRST CZECHI
CLOSE9: SETZ
SIXBIT \CLOSE\ ;CLOSE CHANNEL
401000,,(T) ;CHANNEL #
;;; FILE PRE-CLOSE CLEANUP - RETURNS CHANNEL IN T, TTSAR IN TT
JCLOSE: MOVE TT,TTSAR(A)
TLNE TT,TTS.CL ;SKIP UNLESS ALREADY CLOSED
.LOSE
TLNE TT,TTS.IO ;SKIP UNLESS OUTPUT FILE ARRAY
PUSHJ P,IFORCE ;FORCE OUTPUT BUFFER
MOVE TT,TTSAR(A)
TLNE TT,TTS.TY
SKIPN T,FT.CNS(TT)
JRST CLOSE4
SETZM FT.CNS(TT) ;UNLINK TWO TTY'S WHICH
MOVE T,TTSAR(T) ; WERE TTYCONS'D TOGETHER
SETZM FT.CNS(T) ; IF ONE IS CLOSED
CLOSE4: HRRZ T,F.CHAN(TT)
MOVSI D,TTS.CL ;TURN ON "FILE CLOSED"
IORM D,TTSAR(A) ; BIT IN ARRAY SAR
SETZM CHNTB(T) ;CLEAR CHANNEL TABLE ENTRY
POPJ P,
SUBTTL FORCE-OUTPUT
;;; (FORCE-OUTPUT X) FORCES THE OUTPUT BUFFER OF OUTPUT FILE ARRAY X.
FORCE:
IFN SFA,[
EXCH AR1,A
JSP TT,XFOSP ;AN SFA?
JRST FORSF1
JRST FORSF1
EXCH AR1,A
JSP T,QIOSAV
MOVEI B,QFORCE
SETZ C,
JRST ISTCSH
FORSF1: EXCH AR1,A
] ;END IFN SFA
PUSH P,AR1
MOVEI AR1,(A)
PUSHJ P,FORCE1
POP P,AR1
POPJ P,
FORCE1: PUSHJ P,OFILOK ;DOES A LOCKI
PUSHJ P,IFORCE
IFN ITS,[
.CALL FORCE9
CAIN D,%EBDDV ;"WRONG TYPE DEVICE" ERROR IS OKAY
CAIA
.VALUE ;ANY OTHER ERROR LOSES
] ;END OF IFN ITS
JRST UNLKTRUE
IFN ITS,[
FORCE9: SETZ
SIXBIT \FORCE\ ;FORCE OUTPUT BUFFER TO DEVICE
,,F.CHAN(TT) ;CHANNEL #
403000,,D ;ERROR #
] ;END OF IFN ITS
;;; INTERNAL OUTPUT BUFFER FORCE ROUTINE. EXPECTS USER
;;; INTERRUPTS OFF, AND FILE ARRAY TTSAR IN TT.
;;; CLOBBERS T, TT, D, AND F.
IFORCE: TLNE TT,TTS.CL
LERR [SIXBIT \CAN'T FORCE OUTPUT ON CLOSED FILE!\]
SKIPGE F,F.MODE(TT) .SEE FBT.CM ;CAN'T FORCE A CHARMODE FILE
POPJ P,
MOVE F,FB.BFL(TT)
IFN ITS,[
SUB F,FB.CNT(TT)
JUMPE F,IFORC1
MOVE D,F ;NUMBER OF BYTES TO TRANSFER
MOVE T,FB.IBP(TT) ;INITIAL BYTE POINTER
.CALL SIOT ;OUTPUT THE (PARTIAL) BUFFER
.LOSE 1400
IFORC1:
] ;END OF IFN ITS
IFN D10,[
MOVE T,F.CHAN(TT)
LSH T,27
IOR T,[OUT 0,0]
XCT T ;OUTPUT THE CURRENT BUFFER
CAIA
HALT ;? OUTPUT ERROR
] ;END OF IFN D10
IFN D20,[
SUB F,FB.CNT(TT)
PUSHJ FXP,SAV3 ;PRESERVE ACS 1-3
MOVE 1,F.JFN(TT)
MOVE 2,FB.IBP(TT) ;INITIAL BYTE POINTER
MOVN 3,F ;NEGATIVE OF BYTE COUNT
SOUT ;OUTPUT (PARTIAL) BUFFER
ERJMP .+1 ;IGNORE ERRORS
PUSHJ FXP,RST3
] ;END OF IFN D20
ADDM F,F.FPOS(TT) ;UPDATE FILE POSITION
IFN ITS+D20, JSP D,FORCE6 ;INITIALIZE POINTER AND COUNT
POPJ P,
IFN ITS+D20,[
FORCE6: MOVE T,FB.BFL(TT) ;ROUTINE TO INITIALIZE BYTE POINTER AND COUNT
MOVEM T,FB.CNT(TT)
MOVE T,FB.IBP(TT)
MOVEM T,FB.BP(TT)
JRST (D)
];END IFN ITS+D20
IFN ITS,[
IOTTTT: SETZ
SIXBIT \IOT\ ;I/O TRANSFER
,,F.CHAN(TT) ;CHANNEL #
400000,,T ;DATA POINTER (DATA?)
SIOT: SETZ
SIXBIT \SIOT\ ;STRING I/O TRANSFER
,,F.CHAN(TT) ;CHANNEL #
,,T ;BYTE POINTER
400000,,D ;BYTE COUNT
] ;END OF IFN ITS
SUBTTL STATUS FILEMODE
;;; (STATUS FILEMODE <FILE> ) RETURNS A LIST DESCRIBING
;;; THE FILE: NIL ==> FILE HAS BEEN CLOSED; OTHERWISE
;;; THE CAR OF THIS LIST IS A VALID OPTIONS
;;; LIST FOR THE OPEN FUNCTION. THE CDR OF THIS LIST
;;; CONTAINS INFORMATIVE ITEMS WHICH ARE NOT NECESSARILY
;;; USER-SETTABLE FEATURES ABOUT THE FILE.
;;; PRESENTLY SUCH GOODIES INCLUDE:
;;; RUBOUT AN OUTPUT TTY THAT CAN SELECTIVELY ERASE
;;; CURSORPOS AN OUTPUT TTY THAT CAN CURSORPOS WELL
;;; SAIL FOR AN OUTPUT TTY, HAS SAIL CHARACTER SET
;;; FILEPOS CAN FILEPOS CORRECTLY (RANDOM ACCESS)
;;; NON-FILE ARGUMENT CAUSES AN ERROR.
SFMD0: %WTA NFILE
SFILEMODE:
JSP TT,AFOSP ;MUST BE A FILE OR SFA
JRST SFMD0
IFN SFA,[
JRST SFMD0A ;IF FILE THEN HANDLE NORMALLY
SETZ C, ;IF WE GO TO THE SFA, NO THIRD ARG
MOVEI T,SO.MOD ;CAN THE SFA DO (STATUS FILEMODE)?
MOVEI TT,SR.WOM
TDNE T,@TTSAR(A) ;CAN IT DO THE OPERATION?
JRST ISTCAL ;YES, CALL THE SFA AND RETURN
MOVEI B,QWOP ;OTHERWISE, DO A WHICH-OPERATIONS
PUSHJ P,ISTCSH
PUSH P,A ;SAVE THE RESULTS
MOVEI A,QSFA
JSP T,%NCONS ;MAKE A LIST
POP P,B
JRST CONS ;RETURN ((SFA) {WHICH-OPERATIONS})
SFMD0A: ] ;END IFN SFA
LOCKI
MOVE TT,TTSAR(A) ;GET TTSAR BITS
TLNE TT,TTS.CL ;RETURN NIL IF THE FILE IS CLOSED
JRST UNLKFALSE
MOVE R,F.FLEN(TT) ;IF LENGTH > 0 THEN BLOCK MODE, ELSE SINGLE
MOVEI A,QBLOCK
SKIPGE F,F.MODE(TT) .SEE FBT.CM
MOVEI A,QSINGLE
UNLOCKI
PUSHJ P,NCONS
MOVEI B,QDSK ;TWO MAJOR TYPES - TTY OR DSK
TLNE TT,TTS.TY
MOVEI B,QTTY
PUSHJ P,XCONS
MOVEI B,Q$ASCII ;ASCII, IMAGE, OR FIXNUM
TLNE TT,TTS.IM
MOVEI B,QIMAGE
TLNN TT,TTS.IO
TLNN TT,TTS.TY
JRST SFMD1
TLNN F,FBT.FU ;INPUT TTY: FULL CHAR SET MEANS FIXNUM FILE
SFMD1: TLNE TT,TTS<BN>
MOVEI B,QFIXNUM
PUSHJ P,XCONS
MOVEI B,Q$IN ;INPUT, OUTPUT, OR APPEND MODE
TLNE TT,TTS<IO>
MOVEI B,Q$OUT
TLNE F,FBT<AP>
MOVEI B,QAPPEND
PUSHJ P,XCONS
MOVEI B,QECHO ;OTHER RANDOM MODE BITS - ECHO
TLNE F,FBT.EC
PUSHJ P,XCONS
MOVEI B,QSCROLL ;SCROLL
TLNE F,FBT.SC
PUSHJ P,XCONS
MOVEI C,(A)
SETZ A,
MOVEI B,QSAIL
TLNE F,FBT.SA ;SAIL MODE
PUSHJ P,XCONS
MOVEI B,QRUBOUT
TLNE F,FBT.SE ;RUBOUT-ABLE
PUSHJ P,XCONS
10% MOVEI B,QCURSORPOS ;CURSORPOS-ABLE
10% TLNE F,FBT.CP
10% PUSHJ P,XCONS
MOVEI B,QFILEPOS ;FILEPOS-ABLE
SKIPL R .SEE F.FLEN ;NEGATIVE => CAN'T FILEPOS
PUSHJ P,XCONS
MOVEI B,(C)
JRST XCONS
SUBTTL LOAD FUNCTION
;;; (LOAD FOO) LOADS THE FILE FOO. IT FIRST PROBEF'S TO
;;; ASCERTAIN THE EXISTENCE OF THE FILE, AND CHECKS THE FIRST
;;; WORD TO SEE WHETHER IT IS AN ASCII OR FASL FILE.
;;; IF NO SECOND FILE NAME IS GIVEN, "FASL" IS TRIED FIRST,
;;; AND THEN ">" IF NO FASL FILE EXISTS.
;;; IF A FASL FILE, IT GIVES THE FILE NAMES TO FASLOAD.
;;; IF AN ASCII FILE, IT IS OPENED, (INFILE ↑Q, *, +, -, INSTACK)
;;; BOUND TO (<THE FILE>, T, *, +, -, NIL), AND A READ-EVAL
;;; LOOP PERFORMED UNTIL END OF FILE OCCURS LEAVING INSTACK=NIL
;;; AND INFILE=T.
LOAD: JUMPE A,CPOPJ ;IF GIVEN NIL AS ARG, RETURN NIL
PUSHJ P,FIL6BT ;SUBR 1
20$ MOVE F,-L.6EXT-L.6VRS+1(FXP)
20% MOVS F,(FXP)
PUSHJ P,DMRGF ;DMRGF SAVES F
LOCKI
20% CAIE F,(SIXBIT \*\)
JUMPN F,LOAD3
IFN ITS+D10, MOVE TT,[SIXBIT \FASL\]
IT$ MOVEM TT,-1(FXP)
10$ HLLZM TT,-1(FXP)
20$ MOVE TT,[ASCII \FASL\]
20$ MOVEM TT,-L.6EXT-L.6VRS+1(FXP)
JSP T,FASLP1
JRST LOAD1 ;FILE NOT FOUND
JRST LOAD2 ;FASL FILE
LOAD5: UNLOCKI ;EXPR FILE FOUND
PUSHJ P,6BTNML
PUSH P,[LOAD6]
PUSH P,A
MOVNI T,1
JRST $EOPEN ;OPEN AS A FILE OBJECT
LOAD6: HRRZ B,VIPLUS ;WE WANT +, -, * TO WORK AS FOR TOP LEVEL,
HRRZ C,V. ; BUT NOT SCREW THE OUTSIDE WORLD
HRRZ AR1,VIDIFFERENCE
MOVEI AR2A,TRUTH
JSP T,SPECBIND
0 A,VINFILE
0 B,VIPLUS
0 C,V.
0 AR1,VIDIFFERENCE
0 AR2A,TAPRED
VINSTACK
JRST LOAD7A
LOAD7: PUSHJ P,TLEVAL ;USE THE EVAL PART OF THE TOP LEVEL
HRRZM A,V.
LOAD7A:
REPEAT 2, PUSH P,[LOAD8] ;ONCE FOR RANDOM EOF VALUE
MOVNI T,1
JRST IREAD1
LOAD8: CAIE A,LOAD8
JRST LOAD7
HRRZ B,VINFILE
SKIPN VINSTACK
CAIE B,TRUTH
JRST LOAD7A
PUSHJ P,UNBIND
JRST TRUE
LOAD1:
IT$ MOVSI TT,(SIXBIT \>\) ;OTHERWISE TRY ">"
SA$ MOVSI TT,(SIXBIT \←←←\)
SA% 10$ MOVSI TT,(SIXBIT \LSP\) ;FOR D10, "LSP"
20% MOVEM TT,-1(FXP)
20$ MOVSI TT,[ASCIZ \MACLISP\]
20$ HRRI TT,-L.6EXT-L.6VRS(FXP) ;REMEMBER ADJUSTMENT FOR LOCKI WORD
20$ BLT TT,-L.6EXT-L.6VRS+1(FXP)
MOVEM TT,-1(FXP)
LOAD3: MOVEI A,QLOAD
JSP T,FASLP1
JRST LOAD4 ;LOSE COMPLETELY
JRST LOAD2 ;FASL FILE
JRST LOAD5 ;EXPR CODE
LOAD2: UNLOCKI ;FASL FILE - GO FASLOAD IT
PUSHJ P,6BTNML
HRRZ B,VDEFAULTF
JSP T,SPECBIND
0 B,VDEFAULTF ;DON'T LET FASLOAD CLOBBER DEFAULTF
PUSHJ P,FASLOAD
JRST UNBIND
LOAD4: IOJRST 0,.+1
PUSH P,A
UNLOCKI
PUSHJ P,6BTNML ;LOSEY LOSEY
PUSHJ P,NCONS
POP P,B
JRST XCIOL
;;; (FASLP <FILE>) TELLS WHETHER THE FILE IS A FASL FILE.
;;; ERROR IF FILE DOES NOT EXIST.
$FASLP: PUSHJ P,FIL6BT
PUSHJ P,DMRGF
MOVEI A,Q$FASLP
LOCKI
JSP T,FASLP1
JRST LOAD4
SKIPA A,[TRUTH]
MOVEI A,NIL
UNLOCKI
SUB FXP,R70+4
POPJ P,
;;; ROUTINE TO TEST A FILE FOR FASL-NESS.
;;; JSP T,FASLP1
;;; JRST NOTFOUND ;FILE NOT FOUND, OR OTHER ERROR
;;; JRST FASL ;FILE IS A FASL FILE
;;; ... ;FILE IS NOT A FASL FILE
;;; FXP MUST HOLD THE "SIXBIT" FILE NAMES, WITH A LOCKI WORD ABOVE THEM.
;;; USER INTERRUPTS MUST BE LOCKED OUT.
FASLP1:
IFN ITS,[
.CALL FASLP9 ;OPEN FILE ON TEMP CHANNEL
JRST (T)
.CALL FASLP8 ;RESTORE REFERENCE DATE
JFCL ; (ONLY WORKS FOR DISK CHANNELS - IGNORE FAILURE)
HRROI D,TT
.IOT TMPC,D ;READ FIRST WORD
.CLOSE TMPC,
JUMPL D,2(T) ;NOT A FASL FILE IF ZERO-LENGTH
] ;END OF IFN ITS
IFN D10,[
PUSH P,T
MOVEI T,.IODMP
MOVE TT,-4(FXP)
SETZ D,
OPEN TMPC,T ;OPEN TEMP CHANNEL TO FILE
POPJ P,
MOVE T,-2(FXP) ;FILE NAME
HLLZ TT,-1(FXP) ;EXTENSION
SA$ PUSHJ P,SAEXT
SETZ D,
MOVE R,-3(FXP) ;PPN
LOOKUP TMPC,T ;LOOK UP FILE NAMES
JRST FASLP2
SETZB TT,R
PUSH FXP,NIL ;USE A WORD ON FXP AS D10 CAN'T DO I/O TO AC'S
HRROI D,-1(FXP) ;D AND R ARE THE DUMP MODE COMMAND LIST
INPUT TMPC,D ;GET FIRST WORD OF FILE
SA% CLOSE TMPC,CL.ACS ;DON'T UPDATE ACCESS DATE
RELEASE TMPC,
POP FXP,TT ;GET THE WORD READ FROM THE FILE
POP P,T
SA$ WARN [RESTORE REF DATE FOR SAIL PROBEF?]
;FALLS THROUGH
] ;END OF IFN D10
IFN D20,[
PUSH FLP,(FXP) ;SAVE THE LOCKI WORD, BUT OFF FXP
POPI FXP,1
PUSH P,T
PUSH P,[-1] ;SASY LONG NAMESTRING
PUSHJ P,X6BTNS ;GET NAMESTRING IN PNBUF
POPI P,1
PUSH FXP,(FLP) ;PUT LOCKI WORD BACK IN ITS PLACE
POPI FLP,1
MOVSI 1,(GJ%OLD+GJ%ACC+GJ%SHT) .SEE .GJDEF
MOVE 2,PNBP
GTJFN ;GET A JFN FOR THE FILE NAME
POPJ P,
MOVE 2,[440000,,OF%RD+OF%PDT] .SEE OF%BSZ OF%MOD
SETZ TT,
OPENF ;OPEN FILE, PRESERVING ACCESS DATE
JRST FASLP2
BIN ;GET ONE 36.-BIT BYTE
MOVE TT,2
CLOSF ;CLOSE THE FILE
JFCL ;IGNORE ERROR RETURN
SKIPA ;JFN HAS BEEN RELEASED BY THE CLOSE
FASLP2: RLJFN ;RELEASE THE JFN
JFCL
SETZB 1,2 ;CLEAR OUT CRUD IN 1 AND 2
POP P,T
] ;END OF IFN D20
TRZ TT,1
CAMN TT,[SIXBIT \*FASL*\]
JRST 1(T) ;FASL FILE IF FIRST WORD CHECKS
JRST 2(T)
IFN ITS,[
FASLP8: SETZ
SIXBIT \RESRDT\ ;RESTORE REFERENCE DATE
401000,,TMPC ;CHANNEL #
FASLP9: SETZ
SIXBIT \OPEN\ ;OPEN FILE
5000,,6 ;IMAGE BLOCK INPUT
1000,,TMPC ;CHANNEL NUMBER
,,-4(FXP) ;DEVICE NAME
,,-2(FXP) ;FILE NAME 1
,,-1(FXP) ;FILE NAME 2
400000,,-3(FXP) ;SNAME
] ;END OF IFN ITS
IFN D10,[
FASLP2: RELEASE TMPC,
POPJ P,
]
;;; (DEFUN INCLUDE FEXPR (X)
;;; ((LAMBDA (F)
;;; (EOFFN F '+INTERNAL-INCLUDE-EOFFN)
;;; (INPUSH F))
;;; (OPEN (CAR X))))
INCLUDE:
HLRZ A,(A) ;FSUBR
PUSH P,[INCLU1]
PUSH P,A
MOVNI T,1
JRST $EOPEN
INCLU1: MOVEI TT,FI.EOF
MOVEI B,QINCEOF
MOVEM B,@TTSAR(A)
JRST INPUSH
INCEOF==:FALSE ;INCLUDE'S EOF FUNCTION - SUBR 2
SUBTTL OPEN FUNCTION (INCLUDING SAIL EOPEN)
;;; (OPEN <FILE> <MODELIST>) OPENS A FILE AND RETURNS A
;;; CORRESPONDING FILE OBJECT. IT IS ACTUALLY AN LSUBR
;;; OF ZERO TO TWO ARGUMENTS. THE <FILE> DEFAULTS TO THE
;;; CURRENT DEFAULT FILE NAMES. THE <MODELIST> DEFAULTS
;;; TO NIL.
;;; IF <FILE> IS A NAMELIST OR NAMESTRING, A NEW FILE ARRAY
;;; IS CREATED. IF <FILE> IS A FILE ARRAY ALREADY, IT IS
;;; CLOSED AND RE-OPENED IN THE SPECIFIED MODE; ITS FORMER
;;; MODES SERVE AS THE DEFAULTS FOR THE <MODELIST>.
;;; THE <MODELIST> DETERMINES A LARGE NUMBER OF ATTRIBUTES
;;; FOR OPENING THE FILE. FOR EACH ATTRIBUTE THERE ARE
;;; TWO OR MORE MUTUALLY EXCLUSIVE VALUES WHICH MAY BE
;;; SPECIFIED AS FOLLOWS. VALUES MARKED BY A * ARE THOSE
;;; USED AS DEFAULTS WHEN THE <FILE> IS A NAMELIST OR
;;; NAMESTRING. IF THE <MODELIST> IS AN ATOM, IT IS THE
;;; SAME AS SPECIFYING THE LIST OF THAT ONE ATOM.
;;; DIRECTION:
;;; * IN INPUT FILE
;;; * READ SAME AS "IN"
;;; OUT OUTPUT FILE
;;; PRINT SAME AS "OUT"
;;; APPEND OUTPUT, APPENDED TO EXISTING FILE
;;; DATA MODE:
;;; * ASCII FILE IS A STREAM OF ASCII CHARACTERS.
;;; SYSTEM-DEPENDENT TRANSFORMATIONS MAY
;;; OCCUR, SUCH AS SUPPLYING LF AFTER CR,
;;; OR BEING CAREFUL WITH OUTPUT OF ↑P,
;;; OR MULTICS ESCAPE CONVENTIONS.
;;; FIXNUM FILE IS A STREAM OF FIXNUMS. THIS
;;; IS FOR DEALING WITH FILES THOUGHT OF
;;; AS "BINARY" RATHER THAN "CHARACTER".
;;; FOR TTY'S, THIS IS INTERPRETED AS
;;; "MORE-THAN-ASCII" OR "FULL CHARACTER
;;; SET" MODE, WHICH READS 9 BITS AT SAIL
;;; AND 12. ON ITS.
;;; IMAGE FILE IS A STREAM OF ASCII CHARACTERS.
;;; ABSOLUTELY NO TRANSFORMATIONS ARE MADE.
;;; DEVICE TYPE:
;;; * DSK STANDARD KIND OF FILE.
;;; CLA (ITS ONLY) LIKE DSK, BUT REQUIRES BLOCK MODE,
;;; AND GOBBLES THE FIRST TWO WORDS, INSTALLING
;;; THEM IN THE TRUENAME. USEFUL PRIMARILY FOR
;;; A CLI-MESSAGE INTERRUPT FUNCTION.
;;; TTY CONSOLE. IN PARTICULAR, ONLY TTY INPUT
;;; FILES HAVE INTERRUPT CHARACTER FUNCTIONS
;;; ASSOCIATED WITH THEM.
;;; BUFFERING MODE:
;;; * BLOCK DATA IS BUFFERED.
;;; SINGLE DATA IS UNBUFFERED.
;;; PRINTING AREA:
;;; ECHO (ITS ONLY) OPEN TTY IN ECHO AREA
;;; SOME OF THESE VALUES ARE OF COURSE SYSTEM-DEPENDENT.
;;; YOUR LOCAL LISP SYSTEM WILL ATTEMPT TO DO THE RIGHT THING,
;;; HOWEVER, IN ANY CASE.
;;; IF THE OPTIONS LIST IS INVALID IN ANY WAY, OPEN MAY EITHER
;;; GIVE A WRNG-TYPE-ARGS ERROR, OR BLITHELY ASSUME A CORRECTED
;;; VALUE FOR AN ATTRIBUTE. IN GENERAL, ERRORS SHOULD OCCUR
;;; ONLY FOR TRULY CONFLICTING SPECIFICATIONS. ON THE OTHER
;;; HAND, SPECIFYING BLOCK MODE FOR A DEVICE THAT THE SYSTEM
;;; WANTS TO HANDLE ONLY IN CHARACTER MODE WILL JUST GO AHEAD
;;; AND USE CHARACTER MODE. IN GENERAL, ONE SHOULD USE
;;; (STATUS FILEMODE) TO SEE HOW THE FILE WAS ACTUALLY OPENED.
SA% $EOPEN:
$OPEN: MOVEI D,Q$OPEN ;LSUBR (0 . 2)
CAMGE T,XC-2
JRST WNALOSE
SETZB A,B ;BOTH ARGUMENTS DEFAULT TO NIL
CAMN T,XC-2
POP P,B
SKIPE T
POP P,A
IFN SFA,[
JSP TT,AFOSP ;WERE WE HANDED AN SFA AS FIRST ARG?
JFCL
JRST $OPNNS ;NOPE, CONTINUE AS USUAL
MOVEI C,(B) ;ARG TO SFA IS THE LIST GIVEN TO OPEN
MOVEI B,Q$OPEN ;OPERATION
JRST ISTCSH ;SHORT INTERNAL CALL
$OPNNS: ] ;END IFN SFA
;THE TWO ARGUMENTS ARE NOW IN A AND B.
;WE NOW PARSE THE OPTIONS LIST. F WILL HOLD OPTION VALUES,
; AND D WILL INDICATE WHICH WERE SPECIFIED EXPLICITLY BY THE USER.
OPEN0J: PUSH P,T ;SAVE NUMBER OF ARGS ON P (NOT FXP!)
SETZB D,F
JSP TT,AFILEP ;IS THE FIRST ARGUMENT A FILE OBJECT?
JRST OPEN1A
MOVEI TT,F.MODE
MOVE F,@TTSAR(A) ;IF SO, USE ITS MODE AS THE DEFAULTS
IT$ SKIPE B ;MAKE CHUCK RICH HAPPY - DON'T LET "ECHO" CARRY
IT$ TLZ F,FBT.EC+FBT.CP+FBT.SC ; OVER IF A NON-NULL OPTIONS LIST WAS GIVEN
OPEN1A: JUMPE B,OPEN1Y ;JUMP OUT IF NO OPTIONS SUPPLIED
MOVEI C,(B)
MOVEI TT,(B)
LSH TT,-SEGLOG
SKIPG ST(TT)
JRST OPEN1C
MOVSI AR2A,(B) ;IF A SINGLE, ATOMIC OPTION WAS GIVEN, AR2A
MOVEI C,AR2A ; IS A FAKE CONS CELL SO IT LOOKS LIKE A LIST
OPEN1C: JUMPE C,OPEN1L ;JUMP OUT IF LAST OPTION PROCESSED
HLRZ AR1,(C)
OPN1F1: JUMPE AR1,OPEN1G ;IGNORE NIL AS A KEYWORD
MOVSI TT,-LOPMDS
OPEN1F: HRRZ R,OPMDS(TT) ;COMPARE GIVEN OPTION AGAINST VALID ONES
CAIN AR1,(R)
JRST OPEN1K ;JUMP ON MATCH
AOBJN TT,OPEN1F
EXCH A,AR1 ;ERRONEOUS KEYWORD INTO AR1
WTA [IS ILLEGAL KEYWORD - OPEN!]
EXCH A,AR1
OPEN1G: HRRZ C,(C) ;CDR DOWN LIST UNTIL ALL DONE
JRST OPEN1C
OPEN1K: TDNN D,OPMDS(TT) ;SEE IF THERE IS A CONFLICT
JRST OPEN1Z
OPEN1H: EXCH A,B
WTA [ILLEGAL OPTIONS LIST - OPEN!]
EXCH A,B
JRST OPEN0J
OPEN1Z: HLRZ R,OPMDS(TT)
TLO D,(R)
TLZ F,(R)
TRZ F,(R)
IOR F,OPBITS(TT)
JRST OPEN1G
;;; LEFT HALF IS SET OF MODE BITS WHICH THE OPTION IN THE RIGHT
;;; HALF WILL CONFLICT WITH IF ANY ONE ELSE SELECTS THEM.
OPMDS: FBT.AP+1,,Q$IN
FBT.AP+1,,QOREAD
FBT.AP+1,,Q$OUT
FBT.AP+1,,Q%PRINT
FBT.AP+1,,QAPPEND
000014,,Q$ASCII
000014,,QFIXNUM
000014,,QIMAGE
000002,,QDSK
IT$ FBT.CA+2,,QCLA
000002,,QTTY
FBT.CM,,QBLOCK
FBT.CM,,QSINGLE
0,,QNODEFAULT
IT$ FBT.EC,,QECHO
IT$ FBT.SC,,QSCROLL
LOPMDS==.-OPMDS
;;; MODE BITS ACTUALLY TO BE SET FOR AN OPTION IN THE OPMDS TABLE.
OPBITS: 0 ;IN
0 ;READ
1 ;OUT
1 ;PRINT
FBT.AP,,1 ;APPEND
0 ;ASCII
4 ;FIXNUM
10 ;IMAGE
0 ;DSK
IT$ FBT.CA,,0 ;CLA
2 ;TTY
0 ;BLOCK
FBT.CM,, ;SINGLE
FBT.ND,, ;NODEFAULT
IT$ FBT.EC,, ;ECHO
IT$ FBT.SC,, ;SCROLL
TBLCHK OPBITS,LOPMDS
;STATE OF THE WORLD:
; FIRST ARG TO OPEN IN A
; SECOND ARG IN B
; D CONTAINS BITS FOR ACTUALLY SPECIFIED OPTIONS IN LEFT HALF
; F CONTAINS BITS FOR OPTIONS
.SEE FBT.CM ;AND FRIENDS
; 1.4-1.3 0 => ASCII, 1 => FIXNUM, 2 => IMAGE
; 1.2 0 => DSK, 1 => TTY
; 1.1 0 => IN, 1 => OUT
; BITS 1.4-1.1 ARE USED TO INDEX VARIOUS TABLES LATER
; ACTUAL NUMBER OF ARGS ON P
;WE NOW EMBARK ON DEFAULTING AND MAKING CONSISTENT THE VARIOUS MODES
OPEN1L: TLNE D,FBT.CM ;SKIP IF SINGLE VS. BLOCK WAS UNSPECIFIED
JRST OPEN1Y
TRNE F,2 ;SKIP UNLESS TTY
TLO F,FBT.CM ;FOR TTY, DEFAULT TO SINGLE, NOT BLOCK, MODE
OPEN1Y:
IT$ TRC F,3
IT$ TRCE F,3
IT$ TLZ F,FBT.EC+FBT.SC ;ECHO AND SCROLL MEANINGFUL ONLY FOR TTY OUTPUT
TRNN F,2 ;SKIP IF TTY
JRST OPEN1S
;rpg
TLZ F,FBT.AP ;CAN'T APPEND TO A TTY
TRNN F,1
TLO F,FBT.CM ;CAN'T DO BLOCK TTY INPUT
TRNE F,4 ;FIXNUM TTY I/O USES FULL CHAR SET
TLO F,FBT.FU
;NOW WORRY ABOUT FILE NAMES AND ALLOCATING A FILE OBJECT
OPEN1S: PUSH P,A
PUSH P,B
PUSH FXP,F
CAIE A,TRUTH ;T MEANS TTY FILE ARRAY...
JRST OPEN1M
TRNN F,1
SKIPA A,V%TYI ;TTY INPUT IF MODE BITS SAY INPUT
HRRZ A,V%TYO ; AND OUTPUT OTHERWISE
OPEN1M: PUSH P,A
PUSHJ P,FIL6BT ;GET FILE NAME SPECS
MOVE F,-L.F6BT(FXP) ;GET MODE BITS
TLZN F,FBT.ND ;MERGE WITH DEFAULT NAMES?
PUSHJ P,DMRGF ;MERGE IN DEFAULT NAMES (SAVES F)
HRLZI F,FBT.ND
ANDCAM F,-L.F6BT(FXP) ;TURN OFF FBT.ND BIT IN SAVED FLAGS
MOVE A,(P) ;GET (POSSIBLY MUNGED FOR T) FIRST ARG
JSP TT,AFILEP ;SKIP IF WE GOT A REAL LIVE SAR
JRST OPEN1N
PUSHJ P,ICLOSE ;CLOSE IT IF NECESSARY
20$ WARN [SHOULD WE RELEASE THE JFN AT THIS POINT?]
MOVE A,(P)
MOVE D,-3(P) ;IF ONLY ONE ARG TO OPEN, AND
AOJE D,OPEN1Q ; THAT A SAR, RE-USE THE ARRAY
MOVE F,-L.F6BT(FXP)
MOVEI TT,F.MODE
XOR F,@TTSAR(A)
TDNE F,[FBT.CM,,17]
JRST OPEN1P
PUSHJ P,OPNCLR ;IF TWO ARGS, BUT SAME MODE,
JRST OPEN1Q ; CLEAR ARRAY, THAN RE-USE
;WE MUST ALLOCATE A FRESH ARRAY
OPEN1N: MOVSI A,-1 ;ARRANGE TO GET A FRESH SAR
;WE HAVE A SAR, BUT MUST ALLOCATE A NEW ARRAY BODY
OPEN1P: MOVE F,-L.F6BT(FXP) ;GET MODE BITS AGAIN
;DETERMINE SIZE OF NEW ARRAY
IFN ITS+D20,[
HLRZ TT,OPEN9A(F) ;FOR ITS AND D20, DESIRABLE SIZES ARE IN A TABLE
SKIPGE F .SEE FBT.CM
HRRZ TT,OPEN9A(F)
] ;END OF IFN ITS+D20
IFN D10,[
;FOR D10, WE MUST ASK THE OPERATING SYSTEM FOR THE PROPER BUFFER SIZE
MOVE TT,-3(FXP) ;GET DEVICE NAME
CAME TT,[SIXBIT \TTY\]
TRZ F,2 ;? NOT A TTY UNLESS IT IS *THE* TTY
TRNN F,2
TLZA F,FBT.CM ;ONLY THE TTY CAN BE SINGLE MODE,
TLO F,FBT.CM ; AND THE TTY MUST BE SINGLE MODE!
SA$ TRNE F,2 ;FOR SAIL, *THE* TTY SHOULD DEFAULT TO LINEMODE
SA$ TLO F,FBT.LN
MOVEM F,-4(FXP) ;SAVE BACK MODE BITS
PUSHN FXP,1 ;PUSH A SLOT FOR BUFFER SIZE DATA
JUMPL F,OPEN1R .SEE FBT.CM
IFE SAIL,[
HLRZ T,OPEN9C(F) ;GET DESIRED I/O MODE
MOVEI D,T
DEVSIZ D, ;ON SUCCESS, GET <NUMBER OF BUFFERS,,BUFFER SIZE>
SETO D,
SKIPG D
MOVE D,[2,,3+LIOBUF] ;ON FAILURE, USE 2 BUFFERS AT LIOBFS WORDS APIECE
HLRZ TT,D
CAIGE TT,NIOBFS
] ;END IFE SAIL
IFN SAIL,[
MOVE D,TT ;DEVICE NAME IN D
BUFLEN D, ;GET BUFFER SIZE
SKIPN D ;NO WAY!! (BUT BETTER CHECK ANYWAY)
MOVEI D,LIOBUF+1 ;DEFAULT
ADDI D,2 ;WE NEED ACTUAL SIZE OF BUFFER, NOT SIZE-2
] ;END IFN SAIL
HRLI D,NIOBFS ;HOWEVER, WE MUST USE AT LEAST NIOBFS BUFFERS
MOVEM D,(FXP) ;SAVE THIS DATA
HLRZ TT,D
IMULI D,(TT) ;GET TOTAL SPACE OCCUPIED BY BUFFERS
HLRZ TT,OPEN9A(F)
ADDI TT,(D) ;ADD TO SIZE OF REST OF FILE ARRAY
CAIA
OPEN1R: HRRZ TT,OPEN9A(F) ;FOR CHARACTER MODE, TABLE HAS TOTAL ARRAY SIZE
] ;END OF IFN D10
PUSHJ P,MKLSAR ;MAKE AN ARRAY - SIZE IN TT, SAR (IF ANY) IN A
10$ POP FXP,D
OPEN1Q: LOCKI ;LOCK OUT USER INTERRUPTS
;FALLS THROUGH
;FALLS IN
;STATE OF THE WORLD:
; USER INTERRUPTS LOCKED OUT
; SAR FOR FILE ARRAY IN A
; FOR D10, BUFFER SIZE INFORMATION IN D
; P: FIRST ARGUMENT, OR TTY SAR IF ARGUMENT WAS T
; SECOND ARGUMENT
; FIRST ARGUMENT
; (NEGATIVE OF) ACTUAL NUMBER OF ARGS
; FXP: LOCKI WORD
; FILE NAMES IN "SIXBIT" FORMAT (L.F6BT WORDS)
; MODE BITS
MOVSI TT,TTS.IM+TTS.BN+TTS.TY+TTS.IO
ANDCAM TT,TTSAR(A)
MOVE F,-1-L.F6BT(FXP) ;GET MODE BITS
HLLZ TT,OPEN9B(F)
IORB TT,TTSAR(A) ;SET CLOSED BIT AND FILE TYPE BITS
IFN D10,[
JUMPL F,OPEN1T .SEE FBT.CM
HLRZM D,FB.NBF(TT) ;STORE NUMBER OF BUFFERS
SUBI D,3
HRRZM D,FB.BWS(TT) ;STORE BUFFER DATA SIZE IN WORDS
OPEN1T:
] ;END OF IFN D10
MOVSI TT,AS.FIL
IORB TT,ASAR(A) ;NOW CAN TURN ON FILE ARRAY BIT
MOVEI T,-F.GC
HRLM T,-1(TT) ;SET UP GC AOBJN POINTER
MOVEM A,(P) ;SAVE THE FILE ARRAY SAR
PUSHJ P,ALCHAN ;ALLOCATE A CHANNEL
JRST OPNALZ ;LOSE IF NO FREE CHANNELS
MOVE TT,TTSAR(A)
HRRZM F,F.CHAN(TT) ;SAVE THE CHANNEL NUMBER IN THE FILE OBJECT
POP FXP,T ;BEWARE THE LOCKI WORD!
MOVEI D,F.DEV(TT)
HRLI D,-L.F6BT+1(FXP)
BLT D,F.DEV+L.F6BT-1(TT) ;COPY FILE NAMES INTO FILE OBJECT
POPI FXP,L.F6BT ;FLUSH THEM FROM THE STACK
EXCH T,(FXP) ;PUT LOCKI WORD ON STACK,
PUSH FXP,T ;WITH MODE BITS ABOVE IT
;FALLS THROUGH
;FALLS IN
;STATE OF THE WORLD:
; USER INTERRUPTS LOCKED OUT
; TTSAR OF FILE ARRAY IN TT
; P: SAR FOR FILE ARRAY
; SECOND ARGUMENT TO OPEN
; FIRST ARGUMENT
; -<# OF ACTUAL ARGS>
; FXP: MODE BITS (THEY OFFICIALLY LIVE HERE, NOT IN T)
; LOCKI WORD
;PDLS MUST STAY THIS WAY FROM NOW ON FOR THE SAKE OF IOJRST'S.
.SEE OPENLZ
OPEN3: MOVE T,(FXP) ;GET MODE BITS
;NOW WE ACTUALLY TRY TO OPEN THE FILE
IFN ITS,[
MOVE D,OPEN9C(T)
TLNE T,FBT.AP ;APPEND MODE =>
TRO D,100000 ; ITS WRITE-OVER MODE
TLNE T,FBT.EC ;MAYBE OPEN AN OUTPUT TTY
TRO D,%TJPP2 ; IN THE ECHO AREA (PIECE OF PAPER #2)
.CALL OPENUP
IOJRST 4,OPNLZ0
.CALL RCHST ;READ BACK THE REAL AND TRUE NAMES
.LOSE 1400
] ;END OF IFN ITS
IFN D10,[
JUMPL T,OPEN3M .SEE FBT.CM ;NEED NOT ALLOCATE A CHANNEL FOR *THE* TTY
MOVE F,F.CHAN(TT)
SA$ MOVEI R,(F)
MOVEI D,(F)
IMULI D,3
ADDI D,BFHD0 ;COMPUTE ADDRESS OF BUFFER HEADER
MOVEM D,FB.HED(TT) ;REMEMBER BUFFER HEADER ADR
SETZM (D) ;CLEAR BUFFER POINTER (TO FORCE NEW BUFFERS)
SETZM 1(D) ;CLEAR OLD BYTE POINTER
SETZM 2(D) ;CLEAR BYTE COUNT
TRNE T,1
MOVSS D ;IF OUTPUT BUFFER, PUT ADDRESS IN LEFT HALF
PUSH FXP,TT ;SAVE THE TTSAR
MOVE T,OPEN9C(T) ;GET THE I/O MODE FROM THE TABLE
MOVE TT,F.DEV(TT)
LSH F,27
IOR F,[OPEN 0,T]
XCT F ;OPEN THE FILE
JRST OPNAND
SA$ SHOWIT R,
MOVE R,-1(FXP) ;GET MODE BITS
XOR F,[<INBUF>#<OPEN>]
TRNE R,1
XOR F,[<OUTBUF>#<INBUF>]
MOVE TT,(FXP) ;GET BACK TTSAR
HRR F,FB.NBF(TT) ;GET NUMBER OF BUFFERS IN RH OF UUO
MOVEI TT,FB.BUF(TT)
EXCH TT,.JBFF ;.JBFF IS THE ORIGIN FOR ALLOCATING BUFFERS
XCT F ;TELL THE MONITOR TO ALLOCATE BUFFERS
MOVEM TT,.JBFF ;RESTORE OLD VALUE OF .JBFF
AND F,[0 17,] ;ISOLATE CHANNEL NUMBER AGAIN
IOR F,[LOOKUP 0,T]
MOVE TT,(FXP) ;GET TTSAR BACK IN TT
TRNE R,1 ;WE NEED TO PERFORM A LOOKUP FOR
TLNE R,FBT.AP ; EITHER IN OR APPEND MODE
CAIA
JRST OPEN3C
MOVE T,F.FN1(TT)
MOVE R,F.PPN(TT)
HLLZ TT,F.FN2(TT)
SA$ PUSHJ P,SAEXT
SETZ D,
XCT F ;PERFORM THE LOOKUP
IOJRST 4,OPNLZ1 ;LOSEY LOSEY
OPEN3C: MOVE D,-1(FXP) ;GET MODE BITS
TRNN D,1 ;NEED TO PERFORM AN ENTER FOR
JRST OPEN3D ; EITHER OUT OR APPEND MODE
;rpg fix
TLNN D,FBT.AP ;APPEND MODE MEANS READ-ALTER MODE
;SO DO THE LOOKUP FIRST
;end rpg fix
XOR F,[<ENTER 0,T>#<LOOKUP 0,T>]
MOVE TT,(FXP) ;GET TTSAR
MOVE T,F.FN1(TT)
MOVE R,F.PPN(TT)
HLLZ TT,F.FN2(TT)
SA$ PUSHJ P,SAEXT
SETZ D,
XCT F ;PERFORM THE ENTER
IOJRST 4,OPNLZ1 ;LOSEY LOSEY
;rpg fix
IFN SAIL,[
MOVE D,-1(FXP) ;GET THOSE MODE BITS ONCE MORE
TLNN D,FBT.AP ;APPEND MODE MEANS READ-ALTER
JRST SOPEN3C ;NORMAL CASE SO JUMP AHEAD
XOR F,[<ENTER 0,T>#<LOOKUP 0,T>] ;MUMBLE
MOVE TT,(FXP) ;GET TTSAR
MOVE T,F.FN1
MOVE R,F.PPN(TT)
HLLZ TT,F.FN2(TT)
SA$ PUSHJ P,SAEXT
SETZ D,
XCT F ;PERFORM THE ENTER
IOJRST 4,OPNLZ1 ;LOSEY LOSEY
XOR F,[<OUT 0,>#<ENTER 0,T>]
XCT F ;SET UP BUFFER HEADER BYTE POINTER AND COUNT
XOR F,[<UGETF 0,T>#<OUT 0,>] ;NOW THE UGETF, HEH, HEH
XCT F
JRST OPEN3D ;GO, GO, GO
SOPEN3C:
] ;END IFN SAIL
;end rpg fix
XOR F,[<OUT 0,>#<ENTER 0,T>]
XCT F ;SET UP BUFFER HEADER BYTE POINTER AND COUNT
;AS A RESULT OF THE LOOKUP OR ENTER, THE SIZE INFORMATION IS IN R
OPEN3D: MOVE D,TT
POP FXP,TT
HLLZM D,F.RFN2(TT) ;SAVE AWAY THE REAL, TRUE FILE NAMES
MOVEM T,F.RFN1(TT)
MOVE D,F.CHAN(TT) ;GET CHANNEL FOR DEVCHR
DEVCHR D, ;DEVICE CHRACTERISTICS
TLNE D,(DV.DIR) ;IF NON-DIRECTORY ZERO TRUENAMES
JRST OPN3D1
SETZM F.RFN2(TT)
SETZM F.RFN1(TT)
OPN3D1: MOVE D,F.CHAN(TT)
SA% DEVNAM D, ;GET REAL NAME OF DEVICE
SA$ PNAME D,
MOVE D,F.DEV(TT) ;USE GIVEN DEVICE NAME ON FAILURE
MOVEM D,F.RDEV(TT)
MOVE F,F.CHAN(TT) ;TRY TO DETERMINE REAL PPN
SA% DEVPPN F,
SA% CAIA
SA% JRST OPEN3F
SA% TRZ D,770000
CAMN D,[SIXBIT \SYS\]
JRST OPEN3E
SA% GETPPN F, ;IF ALL ELSE FAILS, ASSUME YOUR OWN PPN
SA% JFCL ;CAN'T REALLY FAIL - THIS JFCL IS FOR ULTRA SAFETY
SA$ SKIPE F,F.PPN(TT) ;IF PPN WAS SPECIFIED
SA$ JRST OPEN3F ;USE IT AS TRUE PPN
SA$ SETZ F,
SA$ DSKPPN F, ;FOR SAIL, USE THE DSKPPN (ALIAS)
JRST OPEN3F
OPEN3E:
SA% MOVE F,[%LDSYS]
SA% GETTAB R,
SA% MOVE F,R70+1 ;ASSUME SYS: IS 1,,1 IF GETTAB FAILS
SA$ MOVE F,[SIXBIT \ 1 3\] ;IT'S [1,3] ON SAIL
OPEN3F: MOVEM F,F.RPPN(TT)
JRST OPEN3N
OPEN3M: MOVE D,F.DEV(TT) ;FOR THE TTY, JUST COPY THE DEVICE NAME
MOVEM D,F.RDEV(TT)
OPEN3N:
] ;END OF IFN D10
IFN D20,[
MOVE T,F.DEV(TT)
CAME T,[ASCII \TTY\] ;SKIP IF OPENING *THE* TTY
JRST OPEN3D
MOVEI 1,.PRIIN ;CONSIDER USING THE PRIMARY JFN
TLNE TT,TTS.IO ; OF THE APPROPRIATE DIRECTION
MOVEI 1,.PRIOU
; GTSTS ;MAKE SURE IT IS OPEN
; JUMPGE 2,OPEN3D .SEE GS%OPN
; MOVSI D,(GS%RDF+GS%NAM) ;MAKE SURE IT CAN DO THE KIND OF I/O WE WANT
; TLNE TT,TTS.IO
; MOVSI D,(GS%WRF+GS%NAM)
; TDC 2,D
; TDCN 2,D
MOVE T,(FXP) ;RESTORE FLAG BITS
JRST OPEN3E
;HERE TO ALLOCATE A FRESH JFN AND OPEN THE FILE
OPEN3D: PUSH FXP,TT ;SAVE THE TTSAR
MOVEI T,F.DEV(TT)
HRLI T,-L.F6BT
PUSH FXP,(T) ;COPY THE GIVEN DEVICE NAMES ONTO THE STACK
AOBJN T,.-1
PUSH P,[-1] ;SAY LONG NAMESTRING
PUSHJ P,6BTNS ;CONVERT TO A NAMESTRING IN PNBUF
POPI P,1
POP FXP,TT ;GET TTSAR
MOVE T,(FXP) ;RESTORE MODE BITS IN T
MOVSI 1,(GJ%ACC+GJ%SHT) .SEE .GJDEF
TRNE T,1
TLNE T,FBT.AP
TLOA 1,(GJ%OLD) ;FOR INPUT OR APPEND, WE WANT AN EXISTING FILE
TLO 1,(GJ%FOU+GJ%NEW) ;FOR OUTPUT, A NON-EXISTENT FILE
MOVE 2,PNBP
GTJFN ;GET A JFN
IOJRST 4,OPNLZ0
OPEN3E: MOVE 2,OPEN9C(T) ;GET OPEN MODE
TLNE T,FBT.AP ;APPEND MODE, SET APPEND, READ BITS, CLR WRITE
TRC 2,OF%APP+OF%WR+OF%RD
OPENF ;OPEN THE FILE
IOJRST 4,OPNLZR
HRRZM 1,F.JFN(TT) ;SAVE THE JFN IN THE FILE OBJECT
] ;END OF IFN D20
;FALLS THROUGH
;FALLS IN
10$ MOVE T,(FXP) ;FOR D10, FLAGS IN T MIGHT HAVE BEEN DESTROYED
JUMPL T,OPEN3G .SEE FBT.CM
MOVE D,OPEN9D(T) ;SOME INITIALIZATION FOR BLOCK MODE FILES
HRRZM D,FB.BYT(TT) ;SET UP BYTE SIZE
IFN ITS+D20,[
HRRI D,FB.BUF-1(TT)
MOVEM D,FB.IBP(TT) ;SET UP INITIAL BUFFER POINTER
HRRZ D,OPEN9B(T)
] ;END OF IFN ITS+D20
10$ MOVE D,FB.BWS(TT)
IMUL D,FB.BYT(TT) ;SET UP BUFFER LENGTH (IN BYTES)
MOVEM D,FB.BFL(TT)
OPEN3G: SETZM F.FPOS(TT) ;FILEPOS=0 (UNTIL FURTHER NOTICE)
;NOW DETERMINE THE SIZE OF THE FILE, AND SET THE ACCESS POINTER (IF APPLICABLE)
;MODE BITS ARE IN T, TTSAR IS IN TT; FOR D10, FILE SIZE INFO IN R;
;FOR D20, JFN IS IN 1
IFN ITS,[
SKIPL F.FLEN(TT) ;THIS WAS SET BY RCHST BEFORE; -1 = NOT RANDOM
JRST OPEN3P ; ACCESS
TLZ T,FBT.AP ;CAN'T APPEND IF NOT RANDOMLY ACCESSIBLE
JRST OPEN3Q
OPEN3P: HRLZI D,1 ;ASSUME 1000000 FOR FAILING FILLEN (USR DEVICE)
.CALL FILLEN ;DETERMINE LENGTH OF FILE
MOVEM D,F.FLEN(TT)
TLNN T,FBT.AP
JRST OPEN3Q
MOVE D,F.FLEN(TT) ;FOR APPEND MODE, SET THE ACCESS
MOVEM D,F.FPOS(TT) ; POINTER TO THE END OF THE FILE
.CALL ACCESS
.LOSE 1400
] ;END OF IFN ITS
IFN D10,[
JUMPL T,OPEN3Q ;DON'T DO ANY OF THIS FOR TTY
SETZM F.FPOS(TT)
MOVE D,F.CHAN(TT)
DEVCHR D,
TLNE D,(DV.DIR)
JRST OPEN3K
;rpg
TLZ T,FBT.AP ;ASSUME A NON-DIRECTORY DEVICE CAN'T APPEND
SETOM F.FLEN(TT) ; OR PERFORM RANDOM ACCESS
JRST OPEN3Q
;FILE SIZE INFORMATION IS IN R
OPEN3K:
IFE SAIL,[
HLRE R,R ;FOR TOPS-10/CMU, THE LEFT HALF OF R
SKIPL R ; IS A WORD COUNT IF NEGATIVE AND A BLOCK COUNT
IMULI R,200 ; IF POSITIVE
MOVMS R
] ;END OF IFE SAIL
IFN SAIL,[
MOVSS R ;SAIL JUST HAS SWAPPED NAGATIVE WORD COUNT
MOVNS R
] ;END OF IFN SAIL
IMUL R,FB.BYT(TT)
MOVEM R,F.FLEN(TT) ;STORE FILE LENGTH
;rpg
TLNN T,FBT.AP
JRST OPEN3Q
MOVEM R,F.FPOS(TT) ;FOR APPEND MODE, SET POINTER TO EOF
MOVE F,F.CHAN(TT)
LSH F,27
SA% IOR F,[USETI 0,-1]
SA$ IOR F,[UGETF 0,R] ;THIS UUO WILL CLOBBER R
XCT F ;SET MONITOR'S POINTER TO EOF
IFN SAIL,[
;HACK UP ON SAIL'S RECORD OFFSET FEATURE
SETZM FB.ROF(TT) ;ASSUME NO RECORD OFFSET
TLNN D,200000 ;SKIP IF DSK/UDP (DEVCHR RESULT IS STILL IN D)
JRST OPEN3Q
MOVEM T,(FXP)
PUSH FXP,TT
XOR F,[<MTAPE 0,T>#<UGETF 0,R>]
MOVE T,[SIXBIT \GODMOD\]
MOVEI TT,20 ;SIXBIT \GODMOD\ ? 20 => GET RECORD OFFSET IN D
XCT F
POP FXP,TT
MOVE T,(FXP) ;CONVERT RECORD OFFSET TO A BYTE OFFSET
SUBI D,1 ; FROM THE LOGICAL ORIGIN OF THE FILE
IMUL D,FB.BFL(TT)
MOVNM D,FB.ROF(TT) ;STORE AS A NEGATIVE OFFSET IN BYTES
] ;END OF IFN SAIL
] ;END OF IFN D10
IFN D20,[
TLNN T,FBT.AP
JRST OPEN3L
SETO 2,
SFPTR ;SET FILE POSITION TO END FOR APPENDING
JRST OPEN3J
RFPTR ;READ BACK THE ACTUAL POSITION
IOJRST 4,OPENLZ
MOVEM 2,F.FLEN(TT)
MOVEM 2,F.FPOS(TT)
JRST OPEN3Q
OPEN3J: CAIE 1,SFPTX2 ;ILLEGAL TO RESET POINTER FOR THIS FILE?
IOJRST 4,OPENLZ
TLZ T,FBT.AP ;IF SO, JUST SAY WE CAN'T APPEND
SETOM F.FLEN(TT)
JRST OPEN3Q
OPN3LA: CAIE 1,DESX4 ;SIZEF LEGAL FOR THIS DEVICE?
IOJRST 4,OPENLZ ;NOPE, MUST BE SOME REAL ERROR
SETO 2, ;ELSE -1 IS LENGTH OF FILE
JRST OPN3LB
OPEN3L: SIZEF ;GET SIZE OF FILE
JRST OPN3LA
OPN3LB: MOVEM 2,F.FLEN(TT) ;SAVE AS LENGTH OF FILE
SETZM F.FPOS(TT) ;SET FILE POSITION TO ZERO
] ;END OF IFN D20
OPEN3Q: MOVEM T,(FXP) ;SAVE BACK POSSIBLY ALTERED MODE BITS
IFN ITS,[
TLNN T,FBT.CA ;FOR THE CLA DEVICE,
JRST OPEN3H ; GOBBLE DOWN THE FIRST TWO WORDS,
MOVEI T,F.RFN1(TT) ; WHICH ARE THE SIXBIT FOR THE
HRLI T,444400 ; UNAME-JNAME OF THE SENDER, AND
MOVEI D,2 ; USE THEM FOR THE TRUENAMES
.CALL SIOT ; OF THE FILE ARRAY
IOJRST 4,OPENLZ
MOVE T,(FXP) ;RESTORE MODE BITS
OPEN3H:
] ;END OF IFN ITS
TRNE T,1
JRST OPEN3V
HRRZ D,DEOFFN ;FOR INPUT, GET THE DEFAULT EOFFN
MOVEM D,FI.EOF(TT)
SETZM FI.BBC(TT)
; SETZM FI.BBF(TT) ;NOT IMPLEMENTED YET
JRST @OPEN3Z(T) ;DISPATCH TO APPROPRIATE PLACE
OPEN3V: HRRZ D,DENDPAGEFN ;FOR OUTPUT, GET THE DEFAULT ENDPAGEFN
MOVEM D,FO.EOP(TT)
MOVE D,DPAGEL ;DEFAULT PAGEL
MOVEM D,FO.PGL(TT)
MOVE D,DLINEL ;DEFAULT LINEL
MOVEM D,FO.LNL(TT)
SETZM FB.BVC(TT)
JRST @OPEN3Z(T) ;DISPATCH TO APPROPRIATE PLACE
OPEN3Z: OPNAI1 ;ASCII DSK INPUT
OPNAO1 ;ASCII DSK OUTPUT
OPNTI1 ;ASCII TTY INPUT
OPNTO1 ;ASCII TTY OUTPUT
OPNBI1 ;FIXNUM DSK INPUT
OPNBO1 ;FIXNUM DSK OUTPUT
OPNTI1 ;FIXNUM TTY INPUT
OPNTO1 ;FIXNUM TTY OUTPUT
OPNAI1 ;IMAGE DSK INPUT
OPNAO1 ;IMAGE DSK OUTPUT
OPNTI1 ;IMAGE TTY INPUT
OPNTO1 ;IMAGE TTY OUTPUT
OPNBO1:
OPNAO1: JUMPL T,OPNAT3 .SEE FBT.CM
MOVE D,FB.BFL(TT)
MOVEM D,FB.BVC(TT)
JRST OPNA6
OPNBI1:
OPNAI1: SETZM FB.BVC(TT)
OPNA6:
IFN ITS+D20,[
JUMPL T,OPNAT3 .SEE FBT.CM
MOVE D,FB.IBP(TT) ;INITIALIZE BUFFER BYTE POINTER
HRRZ R,OPEN9B(T)
TRNN T,1
ADDI D,(R) ;FOR AN INPUT BUFFER, FB.BP MUST BE ADJUSTED;
MOVEM D,FB.BP(TT) ; THE FIRST "EMPTY" BUFFER ISN'T A REAL ONE
MOVE D,FB.BFL(TT)
TRNN T,1
SETZ D,
MOVEM D,FB.CNT(TT)
] ;END OF IFN ITS+D20
JRST OPNAT3
OPNTI1:
10$ JUMPGE T,OPNAI1 .SEE FBT.CM ;ONLY *THE* TTY HAS THESE HACKS
SETZM TI.BFN(TT)
SETZM FT.CNS(TT)
IFN ITS,[
MOVE D,[STTYW1]
MOVEM D,TI.ST1(TT)
MOVE D,[STTYW2]
MOVEM D,TI.ST2(TT)
.CALL TTYGET
IOJRST 4,OPENLZ
;TURN OFF AUTO-INT, SUPER-IMAGE
TLZ F,%TSINT+%TSSII
TRNE T,10 ;TTY IMAGE INPUT =>
TLO F,%TSSII ; ITS SUPER-IMAGE INPUT
.CALL TTYSET
IOJRST 4,OPENLZ
] ;END OF IFN ITS
IFN SAIL,[
MOVEI D,[SACTW1 ? SACTW2 ? SACTW3 ? SACTW4]
HRLI D,TI.ST1(T)
SETACT D
MOVSS D
BLT D,TI.ST4(T)
SETO D,
GETLIN D
AOSN D ;IF NOT -1 THEN OK TO USE CHARACTERISTICS
SETZ D, ; ELSE CAN MAKE NO ASSUMPTIONS ABOUT TTY
TLNE D,460000 ;CHECK DISLIN, DMLIN, DDDLIN
TLOA T,FBT.FU
TLZ T,FBT.FU
MOVEM T,(FXP)
] ;END OF IFN SAIL
IFN D20,[
MOVE 2,[CCOC1]
MOVEM 2,TI.ST1(TT)
MOVE 3,[CCOC2]
MOVEM 3,TI.ST2(TT)
MOVE 1,F.JFN(TT)
SFCOC ;SET CCOC WORDS
MOVEI 2,TT%WKF+TT%WKN+TT%WKP+TT%ECO+<.TTASC←6> .SEE TT%DAM
TRNE T,10
XORI 2,<.TTBIN#.TTASC>←6 .SEE TT%DAM
SFMOD
] ;END OF IFN D20
JRST OPNAT3
OPNTO1:
10$ JUMPGE T,OPNAO1 .SEE FBT.CM ;ONLT *THE* TTY HAS THESE HACKS!
SETZM FT.CNS(TT)
IFN ITS,[
.CALL CNSGET ;SET FO.RPL, FO.LNL, AND GET TTYOPT IN D
IOJRST 4,OPENLZ
MOVSI R,200000 ;INFINITE PAGEL INITIALLY
MOVEM R,FO.PGL(TT)
SOS FO.LNL(TT)
TLZ T,FBT.SA+FBT.CP+FBT.SE
TLNE D,%TOSA1 ;SKIP UNLESS WE HAVE SAIL CHARS
TLO T,FBT.SA ;SET SAIL BIT
TLNE D,%TOMVU ;IF WE CAN MOVE BACK, ASSUME WE
TLO T,FBT.CP ; ARE A DISPLAY TERMINAL (THIS IS OK ACCORDING
; TO ITSTTY)
TLNE D,%TOERS ;REMEMBER THE SELECTIVE ERASE BIT
TLO T,FBT.SE .SEE RUB1CH
MOVEM T,(FXP)
TLNN T,FBT.EC
JRST OPNTO5
.CALL SCML ;FOR ECHO AREA, SET NUMBER OF ECHO LINES TO 5
.LOSE 1400
OPNTO5: .CALL TTYGET
.LOSE 1400
TLNE F,%TSROL ;TURN ON SCROLL MODE IF TTY DEFAULTLY SCROLLS
TLO T,FBT.SC
MOVEM T,(FXP)
TLZ F,%TSFCO
TLNE T,FBT.FU
TLO F,%TSFCO
TLNE T,FBT.SC ;IF SCROLL MODE SET SCROLLING
TLO F,%TSROL
.CALL TTYSAC
.LOSE 1400
PUSHJ FXP,CLRO4 ;INITIALIZE LINENUM AND CHARPOS
JRST OPNA6
] ;END OF IFN ITS
IFN D10,[
MOVSI D,200000 ;INFINITY (???)
EXCH D,FO.PGL(TT)
MOVEM D,FO.RPL(TT)
SETZM AT.CHS(TT) ;SIGH
SETZM AT.LNN(TT)
IFE SAIL,[
SETO R,
GETLIN R, ;GET OUR TTY LINE NUMBER
TLZ R,-1
MOVEI D,.TOWID
MOVE F,[-2,,D]
TRMOP. F, ;TRY DETERMINING WIDTH OF TERMINAL
MOVEI D,111
SUBI D,1
MOVEM D,FO.LNL(TT)
JRST OPNA6
] ;END OF IFE SAIL
;IFN SAIL, FALLS THROUGH TO OPNAT3
] ;END OF IFN D10
IFN D20,[
MOVE 1,F.JFN(TT)
RFMOD ;READ JFN MODE WORD FOR TERMINAL
LDB D,[.BP TT%WID,1]
SUBI D,1
MOVEM D,[FO.LNL(TT)] ;SET LINEL
LDB D,[.BP TT%LEN,1]
MOVEM D,FO.RPL(TT)
TRNN 1,TT%PGM
MOVSI D,200000 ;FOR NON-PAGED MODE, USE INFINITY
MOVEM D,FO.PGL(TT)
PUSHJ FXP,CLRO4 ;INITIALIZE LINENUM AND CHARPOS
JRST OPNA6
] ;END OF IFN D20
IFN ITS,[
TTYGET: SETZ
SIXBIT \TTYGET\ ;GET TTYST1, TTYST2, TTYSTS
,,F.CHAN(TT) ;TTY CHANNEL #
2000,,D ;TTYST1
2000,,R ;TTYST2
402000,,F ;TTYSTS
TTYSET: SETZ
SIXBIT \TTYSET\ ;SET TTYST1, TTYST2, TTYSTS
,,F.CHAN(TT) ;TTY CHANNEL #
,,TI.ST1(TT) ;TTYST1
,,TI.ST2(TT) ;TTYST2
400000,,F ;TTYSTS
SCML: SETZ
SIXBIT \SCML\ ;SET NUMBER OF COMMAND LINES
,,F.CHAN(TT) ;TTY CHANNEL #
401000,,5 ;NUMBER OF LINES
CNSGET: SETZ
SIXBIT \CNSGET\ ;GET CONSOLE PARAMETERS
,,F.CHAN(TT) ;TTY CHANNEL #
2000,,FO.RPL(TT) ;VERTICAL SCREEN SIZE
2000,,FO.LNL(TT) ;HORIZONTAL SCREEN SIZE
2000,,D ;TCTYP (THROW AWAY)
2000,,D ;TTYCOM (THROW AWAY)
402000,,D ;TTYOPT
;TTYTYP NOT GOTTEN
] ;END OF IFN ITS
OPNAT3: TRNE T,2
JRST OPNAT5
SETZM AT.CHS(TT)
SETZM AT.LNN(TT)
OPNAT5: MOVEI D,1
MOVEM D,AT.PGN(TT)
OPEN4: POP FXP,F.MODE(TT)
POP P,A ;SAR FOR FILE ARRAY - RETURNED
MOVEI TT,-1
SETZM @TTSAR(A) ;ILLEGAL FOR LOSER TO ACCESS AS ARRAY
MOVSI TT,TTS<CL>
ANDCAM TT,TTSAR(A) ;UNCLOSE IT
POPI P,3 ;FLUSH 2 ARGS AND # OF ARGS
20$ SETZB 2,3 ;MAKE SURE AC'S CONTAIN NO JUNK
UNLKPOPJ ;WE HAVE WON!
;;; VARIOUS ERROR HANDLERS - ARRIVE WITH A MESSAGE IN C.
OPNALZ: MOVEI C,[SIXBIT \ALL I/O CHANNELS ALREADY IN USE!\]
POP FXP,-L.F6BT-1(FXP) ;FAKE OUT CORRECT PDL CONDITIONS
POPI FXP,L.F6BT-1
OPENLZ: MOVE F,F.CHAN(TT) ;REMEMBER, C HAS ERROR MSG
SETZM CHNTB(F) ;CLOSE CHANNEL AND DEALLOCATE
IFN ITS,[
.CALL ALCHN9
.LOSE 1400
] ;END OF IFN ITS
IFN D10,[
LSH F,27
IOR F,[RELEASE 0,0]
XCT F
] ;END OF IFN D10
IFN D20,[
HRRZ 1,F.JFN(TT)
CLOSF
HALT
] ;END OF IFN D20
OPNLZ0: POP P,AR1 ;FILE OBJECT SAR
POP P,A ;SECOND ARG
POP P,B ;FIRST ARG
POP P,T ;ARG COUNT
JUMPN T,OPNLZ3
MOVEI A,(AR1)
PUSHJ P,NAMELIST
JRST OPNLZ2
OPNLZ3: PUSHJ P,ACONS
EXCH A,B
PUSHJ P,ACONS
CAMN T,XC-2
HRRM B,(A)
OPNLZ2: MOVEI B,Q$OPEN
POPI FXP,1
UNLOCKI
JRST XCIOL
IFN D10,[
OPNAND: MOVEI C,NSDERR ;NO SUCH DEVICE
OPNLZ1: POPI FXP,1
JRST OPNLZ0
] ;END OF IFN D10
IFN D20,[
OPNLZR: RLJFN
HALT
JRST OPNLZ0
] ;END OF IFN D20
IFN ITS,[
OPENUP: SETZ
SIXBIT \OPEN\ ;OPEN FILE
5000,,(D) ;I/O MODE BITS
,,F.CHAN(TT) ;CHANNEL #
,,F.DEV(TT) ;DEVICE NAME
,,F.FN1(TT) ;FILE NAME 1
,,F.FN2(TT) ;FILE NAME 2
400000,,F.SNM(TT) ;SNAME
FILLEN: SETZ
SIXBIT \FILLEN\ ;GET FILE LENGTH (IN WORDS)
,,F.CHAN(TT) ;CHANNEL #
402000,,F.FLEN(TT) ;PUT RESULT IN F.FLEN OF THE FILE OBJECT
ACCESS: SETZ
SIXBIT \ACCESS\ ;SET FILE ACCESS POINTER
,,F.CHAN(TT) ;CHANNEL #
400000,,F.FPOS(TT) ;POSITION
RCHST: SETZ
SIXBIT \RCHST\ ;READ CHANNEL STATUS
,,F.CHAN(TT) ;CHANNEL #
2000,,F.RDEV(TT) ;DEVICE NAME
2000,,F.RFN1(TT) ;FILE NAME 1
2000,,F.RFN2(TT) ;FILE NAME 2
2000,,F.RSNM(TT) ;SNAME
402000,,F.FLEN(TT) ;ACCESS POINTER
] ;END OF IFN ITS
;;; TABLES FOR OPEN FUNCTION
;;; ALL TABLES ARE INDEXED BY THE RIGHT HALF OF THE MODE WORD.
IT$ RBFSIZ==:200 ;RANDOM BUFFER SIZE
20$ RBFSIZ==:200
10$ RBFSIZ==:0
;;; SIZES FOR FILE ARRAYS: <BLOCKMODE SIZE>,,<CHARMODE SIZE>
;;; FOR D10, THIS IS THE SIZE EXCLUSIVE OF THE BUFFER; FOR ITS AND D20, INCLUSIVE.
;;; SIZES ARE IN WORDS.
OPEN9A: FB.BUF+RBFSIZ,,FB.BUF ;ASCII DSK INPUT
FB.BUF+RBFSIZ,,FB.BUF ;ASCII DSK OUTPUT
,,FB.BUF+NASCII/2 ;ASCII TTY INPUT
FB.BUF+RBFSIZ,,FB.BUF ;ASCII TTY OUTPUT
FB.BUF+RBFSIZ,,FB.BUF ;FIXNUM DSK INPUT
FB.BUF+RBFSIZ,,FB.BUF ;FIXNUM DSK OUTPUT
,,FB.BUF+NASCII/2 ;FIXNUM TTY INPUT
FB.BUF+RBFSIZ,,FB.BUF ;FIXNUM TTY OUTPUT
FB.BUF+RBFSIZ,,FB.BUF ;IMAGE DSK INPUT
FB.BUF+RBFSIZ,,FB.BUF ;IMAGE DSK OUTPUT
,,FB.BUF+NASCII/2 ;IMAGE TTY INPUT
FB.BUF+RBFSIZ,,FB.BUF ;IMAGE TTY OUTPUT
;;; <BITS FOR LEFT HALF OF TTSAR>,,<BLOCK MODE BUFFER SIZE>
;;; THE RIGHT HALF IS NOT REALLY USED FOR D10.
OPEN9B:
IRP X,,[A,X,I]J,,[,+BN,+IM] ;ASCII/FIXNUM/IMAGE
IRP Y,,[D,T]K,,[,+TY] ;DSK/TTY
IRP Z,,[I,O]L,,[,+IO] ;IN/OUT
IFSE X!!Y!!Z,IDI, LDGTW5: .SEE LDGTWD ;CROCK
TTS<CL!J!!K!!L>,,RBFSIZ
TERMIN
TERMIN
TERMIN
;;; <LEFT HALF FOR FB.IBP>,,<BYTES PER WORD>
;;; RELEVANT ONLY FOR BLOCK MODE FILES. ONLY THE RIGHT HALF IS USED FOR D10.
OPEN9D: 010700,,5 ;ASCII DSK INPUT
010700,,5 ;ASCII DSK OUTPUT
0 ;ASCII TTY INPUT (IRRELEVANT)
010700,,5 ;ASCII TTY OUTPUT
004400,,1 ;FIXNUM DSK INPUT
004400,,1 ;FIXNUM DSK OUTPUT
0 ;FIXNUM TTY INPUT (IRRELEVANT)
IT$ 001400,,3 ;FIXNUM TTY OUTPUT
10$ SA% 010700,,5
10$ SA$ 001100,,4
20$ 010700,,5
010700,,5 ;IMAGE DSK INPUT
010700,,5 ;IMAGE DSK OUTPUT
0 ;IMAGE TTY INPUT (IRRELEVANT)
10% 041000,,4 ;IMAGE TTY OUTPUT
10$ SA% 010700,,5
10$ SA$ 001100,,4 ? WARN [IMAGE TTY OUTPUT?]
;;; OPEN9C CONTAINS THE OPEN MODE WORD. FOR D10, THE MODE IS ALWAYS
;;; BLOCK MODE IF THIS TABLE IS USED. FOR D20, THERE IS NO DIFFERENCE
;;; IN THIS TABLE FOR BLOCK VERSUS SINGLE MODE.
OPEN9C:
IFN ITS,[
;;; RECALL THE MEANINGS OF THE FOLLOWING BITS IN ITS:
;;; 1.3 0 => ASCII, 1 => IMAGE
;;; 1.2 0 => UNIT (CHARACTER) MODE, 1 => BLOCK MODE
;;; 1.1 0 => INPUT, 1 => OUTPUT
;;; ITS BLOCK MODE IS NOT USED FOR BUFFERED FILES; RATHER, SIOT IS USED.
0 ;ASCII DSK INPUT
1 ;ASCII DSK OUTPUT
0 ;ASCII TTY INPUT
%TJDIS+1 ;ASCII TTY OUTPUT (DISPLAY IF POSSIBLE)
4 ;FIXNUM DSK INPUT
5 ;FIXNUM DSK OUTPUT
%TIFUL+0 ;FIXNUM TTY INPUT (>7 BITS ON IMLACS AND TVS)
%TJDIS+1 ;FIXNUM TTY OUTPUT
0 ;IMAGE DSK INPUT
1 ;IMAGE DSK OUTPUT
0 ;IMAGE TTY INPUT (SUPER-IMAGE INPUT)
%TJSIO+1 ;IMAGE TTY OUTPUT (SUPER-IMAGE OUTPUT)
] ;END OF IFN ITS
IFN D10,[
.IOASC ;ASCII DSK INPUT
.IOASC ;ASCII DSK OUTPUT
.IOASC ;ASCII TTY INPUT
.IOASC ;ASCII TTY OUTPUT
.IOBIN ;FIXNUM DSK INPUT
.IOBIN ;FIXNUM DSK OUTPUT
.IOASC ;FIXNUM TTY INPUT
.IOASC ;FIXNUM TTY OUTPUT
.IOASC ;IMAGE DSK INPUT
.IOASC ;IMAGE DSK OUTPUT
.IOIMG ;IMAGE TTY INPUT
.IOIMG ;IMAGE TTY OUTPUT
] ;END OF IFN D10
IFN D20,[
.SEE OF%BSZ OF%MOD
070000,,OF%RD ;ASCII DSK INPUT
070000,,OF%WR ;ASCII DSK OUTPUT
070000,,OF%RD ;ASCII TTY INPUT
070000,,OF%WR ;ASCII TTY OUTPUT
440000,,OF%RD ;FIXNUM DSK INPUT
440000,,OF%WR ;FIXNUM DSK OUTPUT
070000,,OF%RD ;FIXNUM TTY INPUT
070000,,OF%WR ;FIXNUM TTY OUTPUT
070000,,OF%RD ;IMAGE DSK INPUT
070000,,OF%WR ;IMAGE DSK OUTPUT
100000,,OF%RD ;IMAGE TTY INPUT
100000,,OF%WR ;IMAGE TTY OUTPUT
] ;END OF IFN D20
IFN SAIL,[
;EOPEN FOR SAIL -- HANDLE 'E' FILES
;;; DO AN OPEN, THEN, IF THE FILE IS OPEN IN NON-IMAGE NON-TTY ASCII MODE SKIP
;;; OVER E'S COMMENT BY DOING SUCCESIVE IN'S
$EOPEN: MOVEI TT,(P) ;MUST CALCULATE WHERE RETURN ADR IS
ADD TT,T ;SUBTRACT NUMBER OF ARGS GIVEN
PUSH FXP,(TT) ;REMEMBER USER'S RETURN ADR
MOVEI R,$EOPN1 ;NEW RETURN ADR
MOVEM R,(TT)
JRST $OPEN ;NOW OPEN THE FILE
$EOPN1: MOVEI TT,F.MODE ;GET MODE OF FILE
HRRZ TT,@TTSAR(A)
SKIPE TT ;ASCII, DSK, INPUT?
POPJ FXP, ;NOPE, JUST RETURN
PUSH P,A ;REMEMBER FILE ARRAY
PUSH FXP,[440700,,[ASCIZ \COMMENT ⊗\]]
$EOPN2: ILDB T,(FXP) ;GET NEXT CHARACTER TO LOOK FOR
JUMPE T,$EOPN5 ;LOOKS LIKE WE FOUND AN 'E' FILE, SKIP INDEX
PUSH P,[$EOPN3] ;RETURN ADR
PUSH P,-1(P) ;THE FILE ARRAY TO READ FROM
MOVNI T,1 ;ONE ARG
JRST %TYI+1 ;TYI ONE CHARACTER FROM THE FILE (NCALL)
$EOPN3: JUMPL TT,$EOPN4 ;EOF -- ERROR!
LDB T,(FXP) ;GET THE CURRENT CHARACTER
CAIN T,(TT) ;MATCH?
JRST $EOPN2 ;YES, KEEP SCANNING THE FILE
PUSH P,[$EOPN6] ;NOPE, FILEPOS TO BOF
PUSH P,-1(P) ;FILE ARRAY
PUSH P,CIN0 ;ZERO - LOGICAL BOF
MOVNI T,2 ;TWO ARGS -- SET FILEPOS
JRST FILEPOS
$EOPN6: POPI FXP,1 ;BYTE POINTER
POP P,A ;FILE ARRAY RETURNED IN A
POPJ FXP, ;RETURN TO USER
;HERE WHEN FOUND AN 'E' FILE, SKIP TO AFTER ↑L AFTER NEXT ↑V
$EOPN5: PUSH P,[$EOPN7] ;RETURN ADR
PUSH P,-1(P) ;THE FILE ARRAY TO READ FROM
MOVNI T,1 ;ONE ARG
JRST %TYI+1 ;TYI ONE CHARACTER FROM THE FILE (NCALL)
$EOPN7: JUMPL TT,$EOPN4 ;EOF -- ERROR!
CAIE TT,↑V ;FOUND ↑V?
JRST $EOPN5 ;NOPE, KEEP ON LOOPING
$EOPN8: PUSH P,[$EOPN9] ;RETURN ADR
PUSH P,-1(P) ;THE FILE ARRAY TO READ FROM
MOVNI T,1 ;ONE ARG
JRST %TYI+1 ;TYI ONE CHARACTER FROM THE FILE (NCALL)
$EOPN9: JUMPL TT,$EOPN4 ;EOF -- ERROR!
CAIE TT,↑L ;FOUND ↑L?
JRST $EOPN8 ;NOPE, KEEP ON LOOPING
POPI FXP,1 ;GET RID OF BYTE POINTER
POP P,A ;RETURN FILE ARRAY
POPJ FXP, ;TO USER
$EOPN4: POP P,A ;FILE ARRAY -- EOF, WE LOST
FAC [EOF READING A FILE WHICH LOOKED LIKE AN 'E' FILE - EOPEN!]
] ;END IFN SAIL
SUBTTL DEFAULTF, ENDPAGEFN, EOFFN
;;; (DEFAULTF X) SETS THE DEFAULT NAMELIST TO X.
;;; X IS MERGEF'D WITH THE OLD NAMELIST FIRST.
;;; IT FOLLOWS THAT (DEFAULTF NIL) = (NAMELIST NIL).
DEFAULTF:
PUSHJ P,FIL6BT
PUSHJ P,DMRGF
PUSHJ P,6BTNML
MOVEM A,VDEFAULTF
POPJ P,
SSCRFILE==DEFAULTF
;;; (EOFFN F) GETS INPUT FILE F'S END-OF-FILE FUNCTION.
;;; (EOFFN F X) SETS THE FUNCTION TO BE X.
;;; (ENDPAGEFN F) GETS OUTPUT FILE F'S END-OF-PAGE FUNCTION.
;;; (ENDPAGEFN F X) SETS IT TO BE X.
ENDPAGEFN:
JSP TT,LWNACK ;LSUBR (1 . 2)
LA12,,QENDPAGEFN
MOVEI TT,ATOFOK
MOVEI B,DENDPAGEFN
MOVEI C,QENDPAGEFN
JRST EOFFN0
EOFFN: JSP TT,LWNACK ;LSUBR (1 . 2)
LA12,,QEOFFN
MOVEI TT,IFILOK
MOVEI B,DEOFFN
MOVEI C,QEOFFN
EOFFN0: AOJN T,EOFFN5
POP P,AR1
JUMPE AR1,EOFFN2
IFN SFA,[
PUSH FXP,TT
JSP TT,XFOSP ;SFA?
JRST EOFFNZ
JRST EOFFNZ ;NOPE
POPI FXP,1
MOVEI A,(AR1) ;CALL THE SFA, AND RETURN ITS ANSWER
HRRZI B,(C) ;THE OPERATION -- EOFFN OR ENDPAGEFUN
SETZ C, ;WE WANT THE SFA TO RETURN A VALUE
JRST ISTCSH ;SHORT INTERNAL CALL
EOFFNZ: POP FXP,TT
] ;END IFN SFA
PUSHJ P,(TT)
MOVEI TT,FI.EOF .SEE FO.EOP
HRRZ A,@TTSAR(AR1)
UNLKPOPJ
EOFFN2: HRRZ A,(B)
POPJ P,
EOFFN5: POP P,A
POP P,AR1
JUMPE AR1,EOFFN7
IFN SFA,[
PUSH FXP,TT
JSP TT,XFOSP ;CHECK IF WE HAVE AN SFA
JRST EOFFNY
JRST EOFFNY ;NOPE
POPI FXP,1
JSP T,%NCONS ;LISTIFY IT SO IT IS IDENTIFIABLE AS AN ARG
MOVEI B,(C) ;THE OPERATION
MOVEI C,(A) ;AS THE ARG TO THE SFA
MOVEI A,(AR1) ;THE SFA ITSELF
JRST ISTCSH ;DO THE SHORT INTERNAL CALL
EOFFNY: POP FXP,TT ;UNDO PUSHES
] ;END IFN SFA
PUSHJ P,(TT)
MOVE TT,TTSAR(AR1)
HRRZM A,FI.EOF(TT) .SEE FO.EOP
UNLKPOPJ
EOFFN7: HRRZM A,(B)
POPJ P,
SUBTTL LISTEN FUNCTION
;;; (LISTEN X) LISTENS TO THE SPECIFIED TTY X.
$LISTEN:
SKIPA F,CFIX1 ;LSUBR (0 . 1) NCALLABLE
MOVEI F,CPOPJ
HRRZ AR1,V%TYI
JUMPE T,$LSTN3
MOVEI D,Q$LISTEN
AOJN T,S1WNAL
POP P,AR1 ;FILE ARRAY SPECIFIED
$LSTN3:
IFN SFA,[
JSP TT,XFOSP ;FILE OR SFA?
JRST $LSTNS
JRST $LSTNS ;NOT AN SFA
JSP T,QIOSAV
MOVEI A,(AR1) ;SFA IN A
MOVEI B,Q$LISTEN ;OPERATION
SETZ C, ;NO THIRD ARG
PUSHJ P,ISTCSH ;SHORT INTERNAL SFA INVOCATION
MOVE TT,(A) ;BE PREPARED IF NCALL'ED
POPJ P,
$LSTNS: ] ;END IFN SFA
PUSHJ P,TIFLOK ;IT BETTER BE TTY INPUT
IFN ITS,[
.CALL LISTEN ;SO LISTEN ALREADY
SETZ R, ;ON FAILURE, JUST ASSUME 0
] ;END OF IFN ITS
IFN D10,[
SKIPL T,F.MODE(TT) .SEE FBT.CM
SA$ JRST $LSTN4 ? WARN [REALLY OUGHT TO BE SMARTER]
SA% JRST $LSTN5
IFE SAIL,[
TLNE T,FBT.LN
SKIPA D,[SKPINL]
MOVSI D,(SKPINC)
] ;END OF IFE SAIL
IFN SAIL,[
MOVE D,[SNEAKS R,]
JRST $LSTN6
$LSTN4: MOVE D,F.CHAN(TT)
LSH D,27
IOR D,[TTYSKP 0,]
] ;END OF IFN SAIL
$LSTN6: XCT D
$LSTN5: TDZA R,R
MOVEI R,1
] ;END OF IFN D10
IFN D20,[
HRRZ 1,F.JFN(TT)
SIBE ;SKIP IF INPUT BUFFER EMPTY
SKIPA R,2 ;NUMBER OF WAITING CHARS IN 2
SETZ R,
] ;END OF IFN D20
MOVEI TT,FI.BBC
MOVE A,@TTSAR(AR1) ;ALSO COUNT IN ANY BUFFERED
TLZE A,-1 ; UP CHARACTERS PENDING
AOS R
JSP T,LNG1A
ADD TT,R
UNLOCKI
JRST (F)
IFN ITS,[
LISTEN: SETZ
SIXBIT \LISTEN\ ;LISTEN AT A TTY, ALREADY
,,F.CHAN(TT) ;TTY CHANNEL #
402000,,R ;NUMBER OF TYPED-AHEAD CHARS
] ;END OF IFN ITS
SUBTTL LINEL, PAGEL, CHARPOS, LINENUM, PAGENUM
;;; VARIOUS FUNCTIONS TO GET AND SET A FILE'S LINEL, PAGEL,
;;; CHARPOS, LINENUM, AND PAGENUM.
LINEL: SKIPA D,CFIX1
MOVEI D,CPOPJ
JSP F,FLFROB ;LSUBR (1 . 2)
FO.LNL,,QLINEL
DLINEL,,ATOFOK
PAGEL: SKIPA D,CFIX1
MOVEI D,CPOPJ
JSP F,FLFROB ;LSUBR (1 . 2)
FO.PGL,,QPAGEL
DPAGEL,,ATOFOK
CHARPOS:
SKIPA D,CFIX1
MOVEI D,CPOPJ
JSP F,FLFROB ;LSUBR (1 . 2)
AT.CHS,,QCHARPOS
0,,ATOFOK
LINENUM:
SKIPA D,CFIX1
MOVEI D,CPOPJ
JSP F,FLFROB ;LSUBR (1 . 2)
AT.LNN,,QLINEN
0,,ATFLOK
PAGENUM:
SKIPA D,CFIX1
MOVEI D,CPOPJ
JSP F,FLFROB ;LSUBR (1 . 2)
AT.PGN,,QPAGENUM
0,,ATFLOK
IFN SFA,[
FLFWNA: HRRZ D,(F) ;FUNCTION NAME
JRST WNALOSE ;WNA ERROR
FLNSFL: EXCH AR1,A
WTA [NOT SFA OR FILE!]
] ;END IFN SFA
FLFROB:
IFN SFA,[
CAME T,XC-1 ;WRONG NUMBER OF ARGS?
CAMN T,XC-2
SKIPA
JRST FLFWNA
MOVEI TT,(P) ;TOP OF STACK CONTAINS FILE ARG?
CAMN T,XC-2 ;UNLESS TWO ARGS
MOVEI TT,-1(P)
MOVE A,(TT) ;GET THE ARG
CAIN A,TRUTH
MOVE A,V%TYO
MOVEM A,(TT) ;RE-STORE IT INCASE IT HAS BEEN ALTERED
JUMPE A,FLFRF1 ;IF NIL THEN HANDLE SPECIALLY
EXCH A,AR1
JSP TT,XFOSP
JRST FLNSFL ;NOT AN SFA OR FILE
JRST FLFRFL
AOSE T ;HAVE TWO ARGS?
POP P,AR1 ;YES, IT WILL BECOME SECOND ARG TO SFA
EXCH AR2A,(P) ;SAVE AR2A ON STACK, GET SFA
PUSH P,A ;SAVE OLD AR1
PUSH P,C
PUSH P,B
MOVEI A,(AR2A) ;SFA INTO A
HRRZ B,(F) ;OPERATION NAME INTO B
MOVEI C,(AR1) ;THIRD ARG
PUSHJ P,ISTCSH
POP P,B
POP P,C
POP P,AR1
POP P,AR2A
JSP T,FXNV1 ;MAKE SURE RESULT IS A FIXNUM
POPJ P,
FLFRFL: EXCH A,AR1
FLFRF1: ] ;END IFN SFA
AOJN T,FLFRB5
PUSH P,AR1
MOVE AR1,-1(P)
MOVEM D,-1(P)
JUMPE AR1,FLFRB3
FLFRB1: HRRZ TT,1(F)
PUSHJ P,(TT)
HLRZ TT,(F)
MOVM TT,@TTSAR(AR1) .SEE STERPRI ;LINEL MAY BE NEGATIVE
UNLOCKI
FLFB1A: POP P,AR1
POPJ P,
FLFRB3: HLRZ TT,1(F)
JUMPE TT,FLFRB1
MOVE TT,(TT)
JRST FLFB1A
FLFRB5: POP P,A
JSP T,FXNV1
PUSH P,AR1
MOVE AR1,-1(P)
MOVEM D,-1(P)
MOVE D,TT
JUMPE AR1,FLFRB7
FLFRB6: HRRZ TT,1(F)
PUSHJ P,(TT)
HLRZ TT,(F)
MOVMS D
EXCH D,@TTSAR(AR1)
SKIPGE D
MOVNS @TTSAR(AR1)
UNLOCKI
FLFRB8: MOVE TT,D
JRST FLFB1A
FLFRB7: HLRZ TT,1(F)
JUMPE TT,FLFRB6
MOVMM D,(TT)
JRST FLFRB8
SUBTTL IN
;;; (IN X) INPUTS ONE FIXNUM FROM THE BINARY FILE X AND
;;; RETURNS IT.
$IN: PUSH P,CFIX1 ;SUBR 1 - NCALLABLE - ACS 1
PUSH P,AR1
IFN SFA,[
JSP TT,AFOSP ;FILE OR SFA OR NOT?
JFCL ;NOT, LET OTHER CODE GIVE ERROR
JRST $INNOS ;NOT SFA, PROCEED
POP P,AR1
PUSHJ FXP,SAV5M1 ;SAVE ALL BUT A
MOVEI B,Q$IN ;IN OPERATION
SETZ C, ;NO THIRD ARG
PUSHJ P,ISTCSH ;SHORT +INTERNAL-SFA-CALL
PUSHJ P,RST5M1
MOVE T,CFIX1
CAMN T,(P) ;NCALL'ED?
POPI P,1 ;YUP, WILL RETURN ARGS IN BOTH A AND TT
JSP T,FXNV1 ;INSURE A FIXNUM
POPJ P, ;RETURN
$INNOS: ] ;END IFN SFA
MOVEI AR1,(A)
PUSHJ P,XIFLOK ;LOCKI
IFN ITS+D20,[
MOVEI R,(TT) ;SAVE A COPY OF TTSAR
SKIPL F.MODE(TT) .SEE FBT.CM
JRST $IN2
;FOR ITS AND D20, HANDLE SINGLE MODE FILES
IFN ITS,[
PUSH FXP,[%TIACT] ;ASSUME A TTY
TLNN TT,TTS.TY ;A TTY?
SETZM (FXP) ;NO, SO NO FLAG BITS
MOVE T,[444400,,TT] ;READ ONE 36.-BIT BYTE INTO TT
MOVEI D,1
.CALL INSIOT
.LOSE 1400
POPI FXP,1
JUMPN D,$IN7 ;IF WE GOT NO WORD, ASSUME EOF
] ;END OF IFN ITS
IFN D20,[
PUSH P,B ;PRESERVE AC'S
PUSH P,C
HRRZ 1,F.JFN(TT)
MOVE 2,[444400,,TT] ;READ ONE 36.-BIT BYTE INTO TT
MOVNI 3,1
SIN ;"STRING" INPUT
POP P,C
POP P,B
JUMPN D,$IN7 ;NO BYTE MEANS EOF
] ;END OF IFN D20
AOS F.FPOS(R)
JRST $IN1
] ;END OF IFN ITS+D20
IFN D10,[
SKIPGE F.MODE(TT) .SEE FBT.CM
HALT ;SINGLE MODE BINARY FILE IS ILLEGAL
] ;END OF IFN D10
$IN2:
10$ HRRZ D,FB.HED(TT)
10% SOSGE FB.CNT(TT) ;ARE THERE ANY BYTES LEFT?
10$ SOSGE 2(D)
JRST $IN3 ;NO, GO GET ANOTHER BUFFER FULL
10% ILDB TT,FB.BP(TT) ;YES, GOBBLE DOWN THE NEXT BYTE
10$ ILDB TT,1(D)
$IN1: POP P,AR1
UNLKPOPJ
;GET THE NEXT INPUT BUFFER
$IN3:
IFN ITS,[
MOVE T,FB.IBP(TT)
MOVEM T,FB.BP(TT) ;REINITIALIZE BYTE POINTER
MOVE D,FB.BVC(TT)
ADDM D,F.FPOS(TT) ;UPDATE FILE POSITION
MOVE D,FB.BFL(TT) ;GET BUFFER LENGTH INTO D
MOVE R,D ;GET NEXT BUFFER-LOAD
.CALL SIOT
.LOSE 1400
SUB R,D ;GET COUNT OF BYTES OBTAINED
MOVEM R,FB.CNT(TT)
MOVEM R,FB.BVC(TT)
JUMPN R,$IN2 ;EXIT IF WE GOT ANY (ELSE EOF)
] ;END OF IFN ITS
IFN D10,[
HRRZ F,F.CHAN(TT)
LSH F,27
IOR F,[IN 0,]
XCT F ;GET NEXT INPUT BUFFER
JRST $IN4 ;SUCCESS
XOR F,[<STATO 0,IO.EOF>#<IN 0,>]
XCT F ;SKIP IF EOF
HALT ;ERROR IF NOT EOF?
$IN4: MOVE F,2(D) ;GET, FROM HEADER, NUMBER OF BYTES READ
MOVEM F,FB.BVC(TT) ;STORE IN BUFFER VALID COUNT
JUMPG F,$IN2 ;IF READ ANYTHING THEN USE IT
] ;END OF IFN D10
IFN D20,[
PUSH P,B
PUSH P,C
HRRZ 1,F.JFN(TT)
MOVE 2,FB.IBP(TT)
MOVEM 2,FB.BP(TT)
MOVN 3,FB.BFL(TT)
SIN ;"STRING" INPUT
MOVE D,FB.BVC(TT)
ADDM D,F.FPOS(TT)
ADD D,3
MOVEM D,FB.CNT(TT) ;ACTUAL COUNT OF BYTES OBTAINED
MOVEM D,FB.BVC(TT)
POP P,C
POP P,B
JUMPN D,$IN2 ;JUMP IF WE GOT AT LEAST ONE BYTE
PUSH P,B
GTSTS ;GET FILE STATUS
TLNN 2,(GS%EOF) ;SKIP ON EOF
HALT ;HALT FOR OTHER LOSS
POP P,B
] ;END OF IFN D20
$IN7: MOVEI A,(AR1) ;NO DATA WORDS - EOF
HRRZ T,FI.EOF(TT)
UNLOCKI
POP P,AR1
JUMPE T,$IN8
JCALLF 1,(T) ;CALL USER EOF FUNCTION
$IN8: PUSH P,B ;NO USER EOF FUNCTION
PUSHJ P,NCONS
MOVEI B,Q$IN
PUSHJ P,XCONS
POP P,B
IOL [EOF - IN!] ;SIGNAL ERROR
IFN ITS,[
INSIOT: SETZ
SIXBIT \SIOT\ ;STRING I/O TRANSFER
,,F.CHAN(TT) ;CHANNEL #
,,T ;BYTE POINTER
,,D ;BYTE COUNT
404000,,(FXP)
] ;END IFN ITS
SUBTTL OUT
;;; (OUT X N) OUTPUTS THE FIXNUM N TO THE FILE X. RETURNS T.
$OUT: PUSH P,AR1 ;SUBR 2 - ACS 1
IFN SFA,[
JSP TT,AFOSP ;FILE OR SFA OR NOT?
JFCL ;NOT, LET OTHER CODE GIVE ERROR
JRST $OUTNS ;NOT SFA, PROCEED
POP P,AR1
JSP T,QIOSAV
MOVEI C,(B) ;ARG IS FIXNUM TO OUTPUT
MOVEI B,Q$OUT ;OUT OPERATION
JRST ISTCSH ;SHORT +INTERNAL-SFA-CALL
$OUTNS: ] ;END IFN SFA
JSP T,FXNV2
MOVEI AR1,(A)
PUSHJ P,XOFLOK
SKIPL F.MODE(TT) .SEE FBT.CM
JRST $OUT2
;OUTPUT ONE BYTE TO A SINGLE MODE BINARY FILE
10$ HALT ;SINGLE MODE BINARY FILE ILLEGAL FOR D10
IFN ITS,[
MOVE R,D
MOVEI D,1
MOVE T,[444400,,R]
.CALL SIOT
.LOSE 1400
] ;END OF IFN ITS
IFN D20,[
PUSH P,B
PUSH P,C
HRRZ 1,F.JFN(TT)
MOVE 2,[444400,,D]
MOVNI 3,1
SOUT
POP P,C
POP P,B
] ;END OF IFN D20
IFN ITS+D20,[
AOS F.FPOS(TT)
JRST $OUT1
] ;END OF IFN ITS+D20
$OUT3: PUSH FXP,D
10% SETZM FB.CNT(TT) ;DOING OWN BUFFERED I/O, -1 IN FB.CNT IS N.G.
PUSHJ P,IFORCE ;FORCE OUT CURRENT OUTPUT BUFFER
POP FXP,D
$OUT2:
10$ HRRZ R,FB.HED(TT)
10% SOSGE FB.CNT(TT) ;SEE IF THERE IS ROOM FOR ANOTHER BYTE
10$ SOSGE 2(R)
JRST $OUT3 ;NO, GO OUTPUT THIS BUFFER FIRST
10% IDPB D,FB.BP(TT) ;STICK BYTE IN BUFFER
10$ IDPB D,1(R)
$OUT1: POP P,AR1
JRST UNLKTRUE
SUBTTL FILEPOS, LENGTHF
;;; FILEPOS FUNCTION
;;; (FILEPOS F) RETURNS CURRENT FILE POSITION
;;; (FILEPOS F N) SETQ FILEPOS TO X
;;; FOR ASCII FILES, THE POSITION IS MEASURED IN CHARACTERS;
;;; FOR FIXNUM FILES, IN FIXNUMS (WORDS). ZERO IS THE
;;; BEGINNING OF THE FILE. ERROR IF FILE IS NOT RANDOMLY
;;; ACCESSIBLE.
FILEPOS:
AOJE T,FPOS1 ;ONE ARG => GET
AOJE T,FPOS5 ;TWO ARGS => SET
MOVEI D,QFILEPOS ;ARGH! ARGH! ARGH! ...
JRST S2WNALOSE
IFN D20,[
FPOS0E: POP P,B
JRST FPOS0D
] ;END OF IFN D20
FPOS0B: SKIPA C,FPOS0
FPOS0C: MOVEI C,[SIXBIT \ILLEGAL ACCESS POINTER!\]
FPOS0D: MOVEI A,(B) ;COME HERE FOR TWO-ARG CASE,
PUSHJ P,NCONS ; MESSAGE IN C
JRST FPOS0A
FPOS0: MOVEI C,[SIXBIT \FILE NOT RANDOMLY ACCESSIBLE!\]
SETZ A, ;HERE FOR ONE-ARG ERROR, MESSAGE IN C
FPOS0A: MOVEI B,(AR1)
PUSHJ P,XCONS
MOVEI B,QFILEPOS
UNLOCKI
JRST XCIOL
;ONE-ARGUMENT CASE: GET FILE POSITION
FPOS1: POP P,AR1 ;ARG IS FILE
IFN SFA,[
JSP TT,XFOSP ;DO WE HAVE AN SFA?
JRST FP1SF1 ;NOPE
JRST FP1SF1 ;NOPE
MOVEI A,(AR1) ;YES, CALL THE STREAM
MOVEI B,QFILEPOS
SETZ C, ;NO ARGS
JRST ISTCSH
FP1SF1: ] ;END IFN SFA
PUSHJ P,FILOK ;DOES LOCKI
SKIPGE F.FLEN(TT)
JRST FPOS0 ;ERROR IF NOT RANDOMLY ACCESSIBLE
SKIPGE D,F.FPOS(TT)
JRST FPOS1A
10$ MOVE R,FB.HED(TT)
ADD D,FB.BVC(TT)
10% SUB D,FB.CNT(TT) ;FOR BUFFERED FILES, ADJUST FOR COUNT
10$ SUB D,2(R)
FPOS1A: TLNN TT,TTS<IO>
SKIPN B,FI.BBC(TT)
JRST FPOS2
TLZE B,-1 ;ALLOW FOR ANY BUFFERED BACK CHARS
SUBI D,1
FPOS1C: JUMPE B,FPOS2
HRRZ B,(B)
SA% SKIPLE D
SA$ CAMLE D,FB.ROF(TT) ;FOR SAIL, MAY BE AS LOW AS RECORD OFFSET
SOJA D,FPOS1C
FPOS2: MOVE TT,D ;RETURN POSITION AS FIXNUM
UNLOCKI
JRST FIX1
;TWO-ARGUMENT CASE: SET FILE POSITION
FPOS5: POP P,B ;SECOND ARG IS T, NIL, OR FIXNUM
POP P,AR1 ;FIRST IS FILE
IFN SFA,[
JSP TT,XFOSP ;DO WE HAVE AN SFA?
JRST FP5SF1 ;NOPE, CONTINUE
JRST FP5SF1 ;NOPE
MOVEI A,(B) ;LISTIFY THE ARG
JSP T,%NCONS
MOVEI C,(A) ;PASS IT AS THE ARG TO THE SFA
MOVEI A,(AR1) ;THE SFA
MOVEI B,QFILEPOS ;FILEPOS OPERATION
JRST ISTCSH
FP5SF1: ] ;END IFN SFA
SETZ D,
JUMPE B,FPOS5A ;NIL MEANS ABSOLUTE BEGINNING OF FILE
CAIE B,TRUTH ;T MEANS END OF FILE
JSP T,FXNV2 ;OTHERWISE A FIXNUM POSITION
FPOS5A: PUSHJ P,FILOK ;DOES LOCKI, SAVES D
10$ TLNN TT,TTS.IO ;OUTPUT LOSES FOR D10
SKIPGE F.FLEN(TT) ;NOT RANDOMLY ACCESSIBLE?
JRST FPOS0C
SA% JUMPL D,FPOS0C ;FOR NON-SAIL, NEGATIVE POSITION ILLEGAL
SA$ CAMGE D,FB.ROF(TT) ;FOR SAIL, MAY BE DOWN TO RECORD OFFSET
SA$ JRST FPOS0C
IFN ITS+D20,[
TLNN TT,TTS.IO
JRST FPOS6
PUSH FXP,D
PUSHJ P,IFORCE ;FORCE OUTPUT BUFFER
POP FXP,D
MOVE R,F.FPOS(TT) ;CALCULATE PRESENT FILE POSITION
SKIPL F.MODE(TT)
ADD R,FB.BVC(TT)
SKIPL F.MODE(TT)
SUB R,FB.CNT(TT)
CAMLE R,F.FLEN(TT) ;ADJUST LENGTH UPWARD IF NECESSARY
MOVEM R,F.FLEN(TT)
FPOS6:
] ;END OF IFN ITS+D20
CAMLE D,F.FLEN(TT)
JRST FPOS0C ;LOSE IF SPECIFIED POSITION GREATER THAN LENGTH
SA$ CAIN B,NIL ;R IS BY DEFAULT 0, BUT FOR SAIL
SA$ MOVE D,FB.ROF(TT) ; NIL MEANS USE THE RECORD OFFSET
CAIN B,TRUTH
MOVE D,F.FLEN(TT)
IFE D10,[
TLNE TT,TTS.IO ;DETERMINE IF BYTE WE DESIRE IS IN THE BUFFER
JRST FPOSZ ; IF AN INPUT FILE
MOVE R,F.FPOS(TT) ;POSITION OF FIRST BYTE IN BUFFER
CAMGE D,R ;IF TARGET TOO SMALL THEN MUST DO I/O
JRST FPOSZ
ADD R,FB.BVC(TT) ;ADD IN NUMBER OF BYTES IN THE BUFFER
CAML D,R ;IF TARGET TOO LARGE THEN ALSO MUST DO I/O
JRST FPOSZ
MOVE R,F.FPOS(TT) ;IN RANGE, GET POS OF FIRST BYTE IN BUFFER
SUBM D,R ;MAKE R INTO BYTE OFFSET INTO BUFFER
MOVE D,FB.IBP(TT) ;RESTORE BYTE POINTER
MOVEM D,FB.BP(TT)
MOVE D,FB.BVC(TT) ;GET VALID NUMBER OF BYTES IN BUFFER
SUBI D,(R) ;NUMBER OF BYTES REMAINING
MOVEM D,FB.CNT(TT) ; IS THE NEW COUNT
KAKI SKIPE R
KAKI IBP FB.BP(TT) ;SKIP APPROPRIATE NUMBER OF BYTES
KAKI SOJG R,.-1
KL ADJBP R,FB.BP(TT)
KL MOVEM R,FB.BP(TT)
SETZM FI.BBC(TT) ;CLEAR BUFFERED BACK CHARACTER
JRST UNLKTRUE
FPOSZ:
] ;END IFE D10
MOVEM D,F.FPOS(TT)
IFN ITS,[
.CALL ACCESS ;SET FILE POSITION
IOJRST 0,FPOS0D ;JUMP ON FAILURE
] ;END OF IFN ITS
IFN D20,[
PUSH P,B
CAME D,F.FLEN(TT) ;BE ULTRA CAUTIOUS
SKIPA 2,D
SETO 2,
HRRZ 1,F.JFN(TT)
SFPTR ;SET FILE POINTER
IOJRST 0,FPOS0E
POP P,B
] ;END OF IFN D20
IFN D10,[
IDIV D,FB.BFL(TT) ;DIVIDE FILE POSITION BY BUFFER LENGTH
MOVE T,F.CHAN(TT)
LSH T,27
TLO T,(USETI 0,0)
HRRI T,1(D) ;BLOCKS ARE NUMBERED 1-ORIGIN
XCT T ;POSITION FILE TO CORRECT BLOCK
IMUL D,FB.BFL(TT) ;CALCUALTE F.FPOS
MOVEM D,F.FPOS(TT)
MOVE T,FB.HED(TT)
SETZM 2(T) ;ZERO THE REMAINING BYTE COUNT
HRLZI D,400000 ;NOW WE HAVE TO ZERO ALL USE BITS
FPOS6C: HRRZ T,(T) ;GET POINTER TO NEXT BUFFER
SKIPL (T) ;THIS ONE IN USE?
JRST FPOS6B ;NOPE, SO WE ARE DONE
XORM D,(T) ;CLEAR THE USE BIT
JRST FPOS6C ;AND LOOP OVER ALL BUFFERS
FPOS6B:
] ;END OF IFN D10
10% TLNE TT,TTS.IO
10% JRST FPOS6A
SETZM FB.BVC(TT)
SETZM FI.BBC(TT)
; SETZM FI.BBF(TT) ;NOT IMPLEMENTED YET
FPOS6A:
IFN ITS+D20,[
SKIPGE F.MODE(TT)
JRST UNLKTRUE ;THAT'S ALL FOR SINGLE MODE FILES
TLNE TT,TTS.IO
JRST FPOS7 ;JUMP FOR OUTPUT FILES
] ;END OF IFN ITS+D20
MOVE T,TT
10$ PUSH FXP,R ;R HAS DESIRED BYTE WITHIN BLOCK
PUSHJ P,$DEV5K ;GET NEW INPUT BUFFER
JFCL ;IGNORE EOF
10% JRST UNLKTRUE
IFN D10,[
POP FXP,R
MOVE TT,FB.HED(T)
MOVN D,R
ADDM D,2(TT) ;DECREASE COUNT BY NUMBER OF SKIPPED BYTES
KAKI SKIPE R
KAKI IBP 1(TT) ;SKIP APPROPRIATE NUMBER OF BYTES
KAKI SOJG R,.-1
KL ;DUE TO TOPS-10 LOSSAGE, ADJBP WILL LEAVE BYTE POINTER ALIGNED INCORRECTLY.
KL ; THEREFORE, TO GUARUNTEE CORRECT BIT ALIGNMENT, 1 IBP MUST BE DONE BY HAND
KL JUMPLE R,UNLKTRUE
KL IBP 1(TT)
KL SOJLE R,UNLKTRUE
KL ADJBP R,1(TT)
KL MOVEM R,1(TT)
] ;END OF IFN D10
JRST UNLKTRUE
IFN ITS+D20,[
FPOS7: JSP D,FORCE6 ;INITIALIZE OUTPUT POINTERS
JRST UNLKTRUE
] ;END OF IFN ITS+D20
;;; LENGTHF -- SUBR, 1 ARG, NCALLABLE
;;; RETURNS THE LENGTH OF AN OPEN FILE
$LENWT: EXCH A,AR1
SFA% WTA [NOT A FILE - LENGTHF!]
SFA$ WTA [NOT A FILE OR SFA - LENGTHF!]
$LENGTHF:
PUSH P,CFIX1 ;STANDARD ENTRY, RETURN FIXNUM
;ALTERNATE ENTRY, RETURN NUMBER IN TT
EXCH A,AR1 ;FILE/SFA INTO AR1
JSP TT,XFOSP ;MUST BE EITHER
JRST $LENWT
IFN SFA,[
JRST $LENFL
EXCH AR1,A
JSP T,QIOSAV
MOVEI B,Q$LENGTHF
SETZ C,
PUSHJ P,ISTCSH ;SHORT INTERNAL SFA CALL
MOVE T,CFIX1
CAMN T,(P) ;WE WILL RETURN RESULTS IN A AND TT, SO NO NEED TO RECONS
POPI P,1
JSP T,FXNV1
POPJ P,
$LENFL: ] ;END IFN SFA
EXCH A,AR1
MOVEI TT,F.FLEN ;GET FILE LENGTH
MOVE TT,@TTSAR(A)
POPJ P, ;RETURNS TO CFIX1 OR CPOPJ
SUBTTL CONTROL-P CODES AND TTY INITIALIZATION
IFN ITS,[
;;; PUSH A ↑P CODE INTO A TTY FILE ARRAY IN AR1.
;;; THE CHARACTER TO FOLLOW THE ↑P IS IN D.
;;; IF THE CHARACTER IS "H, "I, OR "V, THEN THE SECOND
;;; CHARACTER IS IN THE LEFT HALF OF D.
;;; CHARPOS, LINENUM, AND PAGEL ARE CORRECTLY UPDATED.
;;; I/O LOSSES DUE TO INTERRUPTS BETWEEN ↑P AND THE
;;; NEXT CHARACTER ARE SCRUPULOUSLY AVOIDED.
;;; CLOBBERS T, TT, D, AND F. SAVES R (SEE RUB1C3).
CNPCOD: .5LKTOPOPJ .SEE INTTYR
.SEE CRSRP7
HLLOS NOQUIT
MOVE T,TTSAR(AR1)
.CALL VAROPT ;GET TTYOPT INTO TT
JRST CZECHI ;OH WELL, ASSUME NOTHING IS LEGAL
XCT CNPOK-"A(D) ;IS THIS FUNCTION DOABLE?
JRST CZECHI ;WOULD HAVE NO AFFECT ANYWAY SO JUST RETURN
CNPCUR: MOVE TT,F.MODE(T)
PUSH FXP,D
JUMPL TT,CNPCD1 .SEE FBT.CM
MOVE TT,FB.CNT(T)
SUBI TT,3
JUMPGE TT,CNPCD1
MOVE TT,T ;IF THERE ISN'T ROOM IN THE CURRENT BUFFER
PUSHJ P,IFORCE ; FOR THE WHOLE ↑P CODE SEQUENCE, FORCE
MOVE T,TTSAR(AR1) ; OUT THE BUFFER TO AVOID TIMING ERRORS
CNPCD1: SETZM ATO.LC(T) ;IF USING ↑P CODES, THEN FORGET WE DID LF
MOVEI TT,↑P ;OUTPUT A ↑P
PUSHJ P,TYOF6
HRRZ TT,(FXP) ;OUTPUT THE CHARACTER
PUSHJ P,TYOF6
HLRZ TT,(FXP)
JUMPE TT,CNPCD2
TRZ TT,400000 ;OUTPUT ANY ADDITIONAL MAGIC ARGUMENT
PUSHJ P,TYOF6
CNPCD2: POP FXP,TT
XCT CNPC9-"A(TT) ;ACCOUNT FOR THE EFFECTS OF THE ↑P CODE
.LOSE
CNPC9: JRST CNP.A ;A ADVANCE TO FRESH LINE
JRST CNP.B ;B MOVE BACK 1, WRAPAROUND
JRST CNP.C ;C CLEAR SCREEN
JRST CNP.D ;D MOVE DOWN, WRAPAROUND
JRST CZECHI ;E CLEAR TO EOF
JRST CNP.F ;F MOVE FORWARD 1, WRAPAROUND
JFCL
JRST CNP.H ;H SET HORIZONTAL POSITION
JRST CNP.I ;I NEXT CHARACTER IS ONE-POSITION PRINTING CHAR
JFCL
JRST CZECHI ;K KILL CHARACTER UNDER CURSOR
JRST CZECHI ;L CLEAR TO END OF LINE
JRST CNP.M ;M GO INTO **MORE** STATE, THEN HOME UP
JRST CZECHI ;N GO INTO **MORE** STATE
JFCL
JFCL ;P OUTPUT A ↑P
JFCL ;Q OUTPUT A ↑C
JFCL ;R RESTORE CURSOR POSITION
JFCL ;S SAVE CURSOR POSITION
JRST CNP.T ;T TOP OF SCREEN (HOME UP)
JRST CNP.U ;U MOVE UP, WRAPPING AROUND
JRST CNP.V ;V SET VERTICAL POSITION
JFCL
JRST CNP.X ;X BACKSPACE AND ERASE ONE CHAR
JFCL
JRST CNP.Z ;Z HOME DOWN
JRST CNP.IL ;[ INSERT LINE ;BEWARE THE BRACKETS!
JRST CNP.DL ;\ DELETE LINE
JRST CZECHI ;] SAME AS L (OBSOLETE)
JRST CZECHI ;↑ INSERT CHARACTER
JRST CZECHI ;← DELETE CHARACTER
VAROPT: SETZ
SIXBIT \TTYVAR\
,,F.CHAN(T) ;CHANNEL
[SIXBIT \TTYOPT\] ;READ THE TTYOPT VARIABLE
402000,,TT ;RETURN RESULT INTO TT
;TABLE OF INSTRUCTIONS TO DETERMINE IF A ↑P CODE IS DOABLE ON THE TERMINAL
CNPOK: SKIPA ;A OK ON ALL TTY'S
TLNN TT,%TOMVB ;B ON TTY'S THAT CAN DO IT DIRECTLY
SKIPA ;C THIS HAS SOME AFFECT ON ALL TTY'S
SKIPA ;D
TLNN TT,%TOERS ;E REQUIRES %TOERS
SKIPA ;F
JFCL
SKIPA ;H
TLNN TT,%TOMVU ;I
JFCL
TLNN TT,%TOMVU ;K ASSUME ONLY ON DISPLAY TERMINALS
TLNN TT,%TOERS ;L
SKIPA ;M
SKIPA ;N
JFCL
SKIPA ;P
SKIPA ;Q
TLNN TT,%TOMVU ;R MAKE SAME ASSUMPTION AS K AND S
TLNN TT,%TOMVU ;S
TLNN TT,%TOMVU ;T WHEREAS C IS MEANINGFUL FOR NON-DISPLAYS, I
; DO NOT FEEL THIS IS
TLNN TT,%TOMVU ;U
TLNN TT,%TOMVU ;V
JFCL
;X TTY'S THAT CAN BACKSPACE AND DON'T OVERSTRIKE
; OR THAT CAN ERASE
PUSHJ P,[TLNN TT,%TOMVB ;MUST BE ABLE TO BACK-UP
POPJ P,
TLNN TT,%TOERS ;IF CAN ERASE IS OK
TLNN TT,%TOOVR ;OR IF DOESN'T OVERSTRIKE
AOS (P)
POPJ P,]
JFCL
TLNN TT,%TOMVU ;Z SAME CRITERIA AS ↑PT
TLNN TT,%TOLID ;[
TLNN TT,%TOLID ;\
TLNN TT,%TOERS ;] SAME AS ↑PL
TLNN TT,%TOCID ;↑
TLNN TT,%TOCID ;←
;;; IFN ITS
CNP.X: ;SAME AS ↑P K ↑P B
CNP.B: MOVE D,FO.LNL(T) ;MOVE BACKWARDS
SUBI D,1
SOSGE AT.CHS(T) ;WRAP AROUND IF AT LEFT MARGIN
MOVEM D,AT.CHS(T)
JRST CZECHI
CNP.M: ;DOES **MORE**, THEN HOMES UP
CNP.C: AOS AT.PGN(T) ;CLEAR SCREEN - AOS PAGENUM
CNP.T: SETZM AT.LNN(T) ;HOME UP - CLEAR LINENUM AND CHARPOS
CNP.IL: ;INSERT LINE - CLEAR CHARPOS
CNP.DL: ;DELETE LINE - CLEAR CHARPOS
SETZM AT.CHS(T)
JRST CZECHI
CNP.A: SKIPN AT.CHS(T) ;CRLF, UNLESS AT START OF LINE
JRST CZECHI
SETZM AT.CHS(T) ;CLEAR CHARPOS, THEN INCR LINENUM
CNP.D: AOS D,AT.LNN(T) ;MOVE DOWN
CAML D,FO.PGL(T) ;WRAP AROUND OFF BOTTOM TO TOP
SETZM AT.LNN(T)
JRST CZECHI
CNP.F: AOS D,AT.CHS(T) ;MOVE FORWARD - WRAP AROUND
CAML D,FO.LNL(T) ; OFF END TO LEFT MARGIN
SETZM AT.CHS(T)
JRST CZECHI
CNP.H: HLRZ D,TT ;SET HORIZONTAL POSITION
TRZ D,400000 ;CLEAR LISP'S FLAG (IF PRESENT)
SUBI D,7 ;ACCOUNT FOR ITS'S 8
SKIPGE FO.LNL(T) ;IF NEGATIVE, THEN ASSUME C(D) IS ACTUAL HPOS
JRST CNP.H1
CAMLE D,FO.LNL(T) ;PUT ON RIGHT MARGIN IF TOO BIG
MOVE D,FO.LNL(T)
CNP.H1: SUBI D,1
MOVEM D,AT.CHS(T)
JRST CZECHI
CNP.I: AOS AT.CHS(T) ;NOT REALLY THE RIGHT THING, BUT CLOSE
JRST CZECHI
CNP.Z: SETZM AT.LNN(T) ;HOME DOWN (GO UP FROM TOP!)
CNP.U: MOVE D,FO.RPL(T) ;MOVE UP
SUBI D,1 ;WRAP AROUND FROM TOP TO BOTTOM
SOSGE AT.LNN(T) ; USING "REAL" PAGE LENGTH
MOVEM D,AT.LNN(T)
JRST CZECHI
CNP.V: HLRZ D,TT ;SET VERTICAL POSITION
SUBI D,7 ;IF TOO LARGE, PUT ON BOTTOM
CAMLE D,FO.RPL(T)
MOVE D,FO.RPL(T)
SUBI D,1
MOVEM D,AT.LNN(T)
JRST CZECHI
;;; VARIOUS ROUTINES FOR PRINTING ↑P CODES
CNPBBL: MOVEI D,"B
PUSHJ P,CNPCOD
CNPBL: MOVEI D,"B
PUSHJ P,CNPCOD
CNPL: MOVEI D,"L
JRST CNPCOD
CNPU: MOVEI D,"U
JRST CNPCOD
CNPF: MOVEI D,"F
JRST CNPCOD
CLRSRN: MOVEI D,"C
JRST CNPCOD
] ;END OF IFN ITS
IFN D20,[
WARN [TOPS-20 CLRSRN]
CLRSRN: POPJ P, ;PUNT THIS FOR NOW
] ;END IFN D20
;;; ROUTINE FOR OPENING UP THE INITIAL TTY FILE ARRAYS.
;;; SKIPS ON SUCCESS (FAILS IF THIS JOB NEVER HAD THE TTY).
IT$ OPNTTY:
IFN ITS,[
.SUSET [.RTTY,,T] ;GET .TTY USER VARIABLE
TLNE T,%TBWAT ;IF SUPERIOR SET %TBWAT, IT CERTAINLY
JRST OPNT0 ; ANTICIPATES OUR OPENING TTY - LET'S OBLIGE
TLNE T,%TBNOT ;ELSE DON'T OPEN IF WE DON'T HAVE THE TTY
] ;END OF IFN ITS
COPNT1: POPJ P,OPNT1
20$ WARN [SHOULD WE NOT OPEN TTY IF DETACHED, OR CHECK .PRIIN?]
IT% OPNTTY:
OPNT0: AOS (P)
HRRZ A,V%TYO
MOVEI TT,FO.EOP
PUSH P,@TTSAR(A)
PUSH P,COPNT1 ;OPEN UP TTY OUTPUT ARRAY
PUSH P,A
MOVNI T,1
JRST $OPEN
OPNT1: MOVEI AR1,(A)
POP P,A
MOVEI TT,FO.EOP
MOVEM A,@TTSAR(AR1)
MOVEI TT,FO.LNL
MOVE TT,@TTSAR(AR1)
MOVEM TT,DLINEL ;SET UP DEFAULT LINEL FROM INITIAL JOB CONSOLE
MOVEI TT,FO.PGL
MOVE TT,@TTSAR(AR1)
MOVEM TT,DPAGEL ;SET UP DEFAULT PAGEL "
PUSH P,[OPNT1A]
PUSH P,AR1
MOVNI T,1
JRST STTYTYPE
OPNT1A: MOVEM A,VTTY ;INITIALIZE "TTY" TO (STATUS TTYTYPE)
HRRZ A,V%TYI
MOVEI TT,TI.BFN
PUSH P,@TTSAR(A)
IFN ITS+D20+SAIL,[
MOVEI TT,TI.ST1
PUSH FXP,@TTSAR(A)
MOVEI TT,TI.ST2
PUSH FXP,@TTSAR(A)
IFN SAIL,[
MOVEI TT,TI.ST3
PUSH FXP,@TTSAR(A)
MOVEI TT,TI.ST4
PUSH FXP,@TTSAR(A)
] ;END OF IFN SAIL
] ;END OF IFN ITS+D20+SAIL
PUSH P,COPNT2 ;OPEN UP TTY INPUT ARRAY
PUSH P,V%TYI
MOVNI T,1
JRST $OPEN
OPNT2:
IFN ITS+D20+SAIL,[
SA$ POP FXP,T
SA$ POP FXP,F
POP FXP,R ;BEWARE THE LOCKI WORD!
POP FXP,D
] ;END OF IFN ITS+D20+SAIL
LOCKI
MOVE TT,TTSAR(A)
POP P,TI.BFN(TT)
IFN ITS+D20+SAIL,[
MOVEM D,TI.ST1(TT)
MOVEM R,TI.ST2(TT)
SA$ MOVEM F,TI.ST3(TT)
SA$ MOVEM T,TI.ST4(TT)
IT$ .CALL TTY2ST
IT$ .LOSE 1400
SA$ MOVEI T,TI.ST1(TT)
SA$ SETACT T
IFN D20,[
HRRZ 1,F.JFN(TT)
MOVE 2,TI.ST1(TT)
MOVE 3,TI.ST2(TT)
SFCOC
SETZB 2,3
] ;END OF IFN D20
] ;END OF IFN ITS+D20+SAIL
UNLOCKI
HRRZ A,V%TYI
HRRZ B,V%TYO
PUSHJ P,SSTTYCONS ;CONS THEM TOGETHER AS CONSOLE
COPNT2: POPJ P,OPNT2
SUBTTL CLEAR-INPUT, CLEAR-OUTPUT
;;; (CLEAR-INPUT X) CLEARS ANY PENDING INPUT.
;;; CURRENTLY ONLY EFFECTIVE FOR TTY'S.
CLRIN: PUSH P,AR1 ;SUBR 1
MOVEI AR1,(A)
PUSHJ P,IFILOK ;MAKE SURE ARGUMENT IS AN INPUT FILE
TLNE TT,TTS.TY
PUSHJ FXP,CLRI3 ;IF A TTY, CLEAR ITS INPUT
JRST $OUT1
CLRI3:
IFN ITS,[
.CALL CLRIN9 ;RESET TTY INPUT AT ITS LEVEL
.LOSE 1400
] ;END OF IFN ITS
IFN D10,[
MOVE D,F.DEV(TT)
CAMN D,[SIXBIT \TTY\]
CLRBFI
] ;END OF IFN D10
IFN D20,[
PUSH P,A
HRRZ 1,F.JFN(TT)
CFIBF ;CLEAR FILE INPUT BUFFER
POP P,A
] ;END OF IFN D20
SETZM FI.BBC(TT) ;CLEAR BUFFERED-BACK CHARS
; SETZM FI.BBF(TT) ;CLEAR BUFFERED-BACK FORMS
POPJ FXP,
IFN ITS,[
CLRIN9: SETZ
SIXBIT \RESET\ ;RESET I/O CHANNEL
400000,,F.CHAN(TT) ;CHANNEL #
] ;END OF IFN ITS
;;; (CLEAR-OUTPUT X) CLEARS ANY OUTPUT NOT ACTUALLY ON
;;; THE OUTPUT DEVICE YET. CURRENTLY ONLY EFFECTIVE FOR TTY'S.
CLROUT: PUSH P,AR1 ;SUBR 1
MOVEI AR1,(A)
PUSHJ P,OFILOK
TLNE TT,TTS<TY> ;SKIP IF TTY
PUSHJ FXP,CLRO3
JRST $OUT1
CLRO3:
IFN ITS,[
.CALL CLRIN9 ;RESET CHANNEL
.LOSE 1400
CLRO4: .CALL RCPOS1 ;RESET CHARPOS AND LINEL
.LOSE 1400
HLL T,F.MODE(TT)
TLNE T,FBT.EC
MOVE D,R ;FOR ECHO MODE, USE ECHO MODE CURSORPOS
HLRZM D,AT.LNN(TT)
HRRZM D,AT.CHS(TT)
] ;END OF IFN ITS
IFN D10,[
MOVE D,F.DEV(TT)
CAMN D,[SIXBIT \TTY\]
CLRBFO
] ;END OF IFN D10
IFN D20,[
PUSH P,A
HRRZ 1,F.JFN(TT)
CFOBF ;CLEAR FILE OUTPUT BUFFER
CAIA
CLRO4: PUSH P,A
PUSH P,B
HRRZ 1,F.JFN(TT)
RFPOS ;READ FILE POSITION
HLRZM 2,AT.LNN(TT) ;STORE LINENUM
HRRZM 2,AT.CHS(TT) ;STORE CHARPOS
POP P,B
POP P,A
] ;END OF IFN D20
10% PUSH FXP,T
10% TLNN T,FBT.CM ;IF BLOCK MODE, RESET
10% JSP D,FORCE6 ; LISP BUFFER POINTERS
10% POP FXP,T
POPJ FXP,
IFN ITS,[
RCPOS1: SETZ
SIXBIT \RCPOS\ ;READ CURSOR POSITION
,,F.CHAN(TT) ;CHANNEL #
2000,,D ;MAIN CURSOR POSITION
402000,,R ;ECHO CURSOR POSITION
] ;END OF IFN ITS
;;; STANDARD **MORE** PROCESSOR
TTYMOR: PUSHJ P,STTYCONS ;SUBR 1
JUMPE A,CPOPJ ;STTYCONS LEFT ARG IN AR1
PUSH P,AR1
PUSH P,A
SETZ A, ;RESET NOINTERRUPT STATUS
PUSHJ P,NOINTERRUPT ; SO INTERRUPT CHARS WILL TAKE EFFECT
HRRZ AR1,-1(P)
STRT AR1,[SIXBIT \####MORE####!\] ;# IS QUOTE CHAR
TTYMO3: PUSH P,[TTYMO1]
PUSH P,R70
PUSH P,-2(P)
MOVNI T,2
JRST TYIPEEK+1
TTYMO1: PUSH P,[TTYMO2]
PUSH P,-1(P)
MOVNI T,1
CAILE TT,40
CAIN TT,177
JRST %TYI+1 ;SWALLOW SPACE OR RUBOUT
POPI P,2
TTYMO2: CAIE TT,↑S ;DON'T IGNORE ↑S
CAIN TT,33 ;OR <ALT>
JRST TTYMOZ
CAIGE TT,40 ;COMPLETELY IGNORE CONTROL CHARS
JRST TTYMO3 ? SA$ WARN [SAIL TTYMOR?]
TTYMOZ: POPI P,1
POP P,AR1
IT% POPJ P,
IFN ITS,[
MOVE D,[10,,"H] ;GO TO BEGINNING OF LINE
PUSHJ P,CNPCOD
PUSHJ P,CNPL ;CLEAR TO END OF LINE
HRLI AR1,600000 ;FLAG TO TERPRI (THIS IS ACTUAL FILE ARRAY)
JRST TERP1 ;DO SEMI-INTERNAL TERPRI
] ;END OF IFN ITS
IFN SFA,[
SUBTTL SFA FUNCTIONS (INTERNAL AND USER)
; (SFA-CREATE <old-sfa or sfa-function>
; <amount-of-local-user-storage>
; <printname>)
STCREA: SKOTT A,LS\SY
JRST STCRE1
;HERE TO CREATE A NEW SFA: SFA-FUNCTION IN A, LISP FIXNUM IN B
STCREN: SKOTT B,FX ;FIXNUM AS SECOND ARG?
JRST STCRE2 ;NOPE, ERROR
PUSH P,A
PUSH P,B
PUSH P,C
MOVE TT,(B) ;GET THE LENGTH OF THE USER AREA
ADDI TT,<SR.LEN*2>+1 ;TO INSURE GETTING ENOUGH HALFWORDS
LSH TT,-1 ;THEN CONVERT TO NUMBER OF WORDS
MOVSI A,-1 ;JUST NEED THE SAR
PUSHJ P,MKLSAR ;GET A GC-PROTECTED ARRAY
POP P,C
LOCKI ;GOING TO HACK WITH THE ARRAY
MOVE TT,TTSAR(A) ;POINTER TO THE ARRAY DATA AREA
POP P,B ;LENGTH OF THE USER DATA AREA
MOVE T,(B)
MOVEM T,SR.UDL(TT) ;REMEMBER LENGTH OF USER DATA
EXCH A,(P) ;RESTORE FUNCTION AND SAVE SAR ADR
HRLI A,(CALL 3,) ;A CALL FUNCTION GOES IN UN-MARKED-FROM SLOT
MOVEM A,SR.CAL(TT) ;STORE THE CALL INSTRUCTION
HRRZM A,SR.FUN(TT) ;STORE THE FUNCTION
HRRZM C,SR.PNA(TT) ;STORE THE PRINTNAME
ROT T,-1 ;LENGTH OF USER AREA IN T
SKIPGE T ;CONVERT INTO NUMBER OF WORDS NEEDED
ADDI T,1
ADDI T,SR.LEN-SR.FML ;NUMBER OF SYSTEM WORDS MARKED
MOVNI R,(T) ;NUMBER OF WORDS TO MARK
HRLZI R,(R) ;IN LEFT HALF
HRRI R,SR.FML(TT) ;POINTER TO FIRST MARKED LOCATION IN RH
HRRZ D,@(P) ;GET SAR
MOVEM R,-1(D) ;STORE GC MARKING AOBJN POINTER
HRLZI TT,AS.SFA ;TURN THE ARRAY INTO AN SFA
IORM TT,@(P) ;TURN ON SFA BIT IN THE SAR
UNLOCKI ;ALLOW INTERRUPTS AGAIN
;THE FOLLOWING CODE SIMULATES:
; (SFA-CALL <NEWLY-CREATED-SFA> 'WHICH-OPERATIONS NIL)
HRRZ A,(P) ;FIRST ARG TO SFA IS SFA-OBJCT ITSELF
MOVEI B,QWOP ;WHICH-OPERATIONS
SETZ C, ;NO THIRD ARG
MOVEI TT,SR.CAL ;CALL INSTRUCTION SLOT
XCT @TTSAR(A) ;DO CALL INDIRECTLY THROUGH TTSAR
JUMPE A,STCRE3 ;THE SFA CAN'T DO ANYTHING, BUT WHY WORRY...
SKOTT A,LS ;BETTER HAVE GOTTEN A LIST BACK
JRST SCREBS ;BAD SFA IF DIDN'T GET BACK A LIST!
STMASK: SETZ F, ;F ACCUMLATES KNOWN SYSTEM OPERATIONS MASK
STCRE4: MOVE R,[-STKNOL,,STKNOT] ;AOBJN POINTER OVER KNOWN OPERATIONS
HLRZ B,(A) ;CAR IS THE OPERATION
STCRE5: HRRZ T,(R) ;KNOWN OPERATIOON
CAIE T,(B) ;MATCH?
JRST STCRE6 ;NOPE, KEEP LOOPING
HRRZ T,R ;GET POINTER
HLLZ TT,(R) ;GET MASK
CAIL R,STKNOT+18. ;LEFT HALF VALUE?
MOVSS TT ;NOPE, ASSUMED WRONG
TDOA F,TT ;ACCUMLATE THIS OPERATION AND EXIT LOOP
STCRE6: AOBJN R,STCRE5 ;CONTINUE LOOPING UNTIL ALL LOOPED OUT
HRRZ A,(A) ;CDR DOWN THE WHICH-OPERATIONS LIST
JUMPN A,STCRE4 ;DON'T JUMP IF DON'T HAVE TO
STCRE3: POP P,A ;POINTER TO SAR
MOVEI TT,SR.WOM ;POINT TO KNOWN OPERATIONS MASK
MOVEM F,@TTSAR(A) ;STORE IN ARRAY
POPJ P, ;THEN RETURN SAR
STCRE2: EXCH B,A ;C(B) WAS NOT A FIXNUM
WTA [FIRST ARG MUST BE A FIXNUM -- SFA-CREATE!]
EXCH B,A
JRST STCREN
SCREBS: FAC [WAS RETURNED FROM WHICH-OPERATIONS BUT SHOULD HAVE BEEN A LIST -- SFA-CREATE!]
STCRE1: FAC [CALLED WITH SFA, NOT IMPLIMENTED -- SFA-CREATE!]
;SFA OPERATION/INTERNAL BIT CORRESPONDANCE TABLE
STKNOT:
;LH BITS
SO.OPN,,Q$OPEN
SO.CLO,,Q$CLOSE
SO.REN,,Q$RENAMEF
SO.DEL,,Q$DELETEF
SO.TRP,,Q%TERPRI
SO.PR1,,Q%PR1
SO.TYI,,Q%TYI
SO.UNT,,QUNTYI
SO.TIP,,QTYIPEEK
SO.IN,,Q$IN
SO.EOF,,QEOFFN
SO.TYO,,Q%TYO
SO.OUT,,Q$OUT
SO.FOU,,QFORCE
SO.RED,,QOREAD
SO.RDL,,Q%READLINE
SO.PRT,,Q%PRINT
SO.PRC,,Q%PRC
;RH BITS
SO.MOD,,QFILEMODE
SO.POS,,QFILEPOS
STKNOL==:.-STKNOT ;LENGTH OF TABLE
;;; (SFA-CALL <sfa-object> <operation> <extra-arg>)
STCAL1: WTA [SHOULD BE AN SFA OBJECT -- SFA-CALL!]
STCALL: SKOTT A,SA ;MUST BE AN ARRAY HEADER
JRST STCAL1
HRLZI TT,AS.SFA ;NOW CHECK FOR SFA-NESS
TDNN TT,ASAR(A)
JRST STCAL1 ;AN ARRAY BUT NOT A REAL SFA
MOVEI TT,SR.CAL
XCT @TTSAR(A) ;INVOKE THE SFA
POPJ P,
;INTERNAL SFA CALL, BIT INDICATNG OP IN T, SFA-OBJECT IN AR1,
; THIRD ARG TO SFA IN C. RETURNS VALUE OF SFA IN A. DESTORYS ALL
; ACS.
ISTCAL: JFFO T,ISTCA0 ;MUST HAVE ONE BIT SET
LERR [SIXBIT \+INTERNAL-SFA-CALL CALLED WITH NO OP IN T!\]
ISTCA0: HRRZ B,STKNOT(TT) ;GET SYMBOL REPRESENTING OPERATION
MOVEI A,(AR1) ;SFA GETS ITSELF AS FIRST ARG
MOVEI TT,SR.WOM ;CHECK FOR LEGAL OP -- USE WHICH OP MASK
TDNN T,@TTSAR(A) ;MAKE SURE THIS INTERNAL OP IS DOABLE
JRST ISTCA1
;ENTER HERE FOR 'SHORT' INTERNAL CALL PROTOCOL, A, B, AND C SET UP CORRECTLY
ISTCSH: MOVEI TT,SR.CAL ;EXECUTE THE CALL TO THE SFA
XCT @TTSAR(A)
POPJ P, ;RETURN TO CALLER WITH RESULT IN A
ISTCA1: PUSH P,[ISTCA2] ;RETURN ADDRESS
PUSH P,A ;LISTIFY IMPORTANT INFO
PUSH P,B
PUSH P,C
MOVNI T,3 ;3 ARGS
JRST LIST ;DO IT!
ISTCA2:
FAC [ATTEMPT TO INVOKE SFA ON AN UNSUPPORTED OPERATION -- +INTERNAL-SFA-CALL!]
;;; (SFAP <object>) RETURNS T IF <object> IS AN SFA, ELSE NIL
STPRED: JSP TT,AFOSP ;CHECK IF A FILE OR SFA
JRST FALSE ;NEITHER, RETURN NIL
JRST FALSE ;FILE, RETURN FALSE
JRST TRUE ;SFA, RETURN TRUE
;;; (SFA-GET <sfa-object> <fixnum or system-location-name>)
;;; (SFA-STORE <sfa-object> <fixnum or system-location-name> <new-value>)
STSTOR: SKIPA F,[STSTOD] ;SFA-STORE DISPATCH TABLE
STGET: MOVEI F,STGETD ;SFA-GET DISPATCH TABLE
SKIPA
STDISW: WTA [NOT AN SFA -- SFA-GET/SFA-STORE!]
JSP TT,AFOSP ;INSURE WE HAVE AN SFA, A ==> AR1
JRST STDISW ;NOT AN SFA
JRST STDISW ;A FILE-OBJECT, BUT STILL NOT AN SFA
SKOTT B,FX ;FIXNUM AS SECOND ARG?
JRST STDIS1 ;NOPE, MUST BE A SYSTEM-LOCATION NAME
MOVE R,(B) ;GET THE ACTUAL FIXNUM
MOVEI TT,SR.UDL ;CHECK AGAINST THE MAXIMUM VALUE
CAML R,@TTSAR(AR1) ;IN RANGE?
JRST STDIOB ;NOPE, GIVE OUT-OF-BOUNDS CALL
ROT R,-1 ;MAKE INTO AN OFFSET AND A FLAG BIT (RH/LH)
JRST @-1(F) ;GIVE USER LOCATION ACCESS RETURN
STDIOB: EXCH A,B ;GIVE AN OUT-OF-BOUNDS ERROR
FAC [USER-INDEX OUT-OF-BOUNDS -- SFA-GET/SFA-STORE!]
STDIS1: MOVE T,[-STRSLN,,0] ;FIND SYS-LOC THAT 2ND ARG IS EQ TO
STDIS2: CAME B,STSYSL(T) ;MATCH THIS ENTRY?
AOBJN T,STDIS2 ;NOPE, CONTINUE THE LOOP
ADDI T,(F) ;MAKE CORRECT TABLE ADDRESS
SKIPGE T ;BUT DID WE REALY FIND A MATCH?
JRST @(T) ;YES, SO DISPATCH
EXCH A,B
FAC [ILLEGAL SYSTEM-LOCATION NAME -- SFA-GET/SFA-STORE!]
;SFA SYSTEM-NAME TABLE
STSYSL: QFUNCTION ;FUNCTION
QWOP ;WHICH-OPERATIONS
QPNAME ;PNAME
STRSLN==:.-STSYSL
;SFA-GET DISPATCH TABLE AND FUNCTIONS
STGETU ;USER LOCATION
STGETD: STGFUN ;FUNCTION
STGWOM ;OPERATIONS MASK
STGPNA ;PRINT NAME
STGETU: MOVEI TT,SR.FUS(R) ;INDEX INTO ARRAY
HLRZ A,@TTSAR(AR1) ;TRY THE LEFT HALF
SKIPGE R ;BUT IS IT THE RIGHT HALF?
HRRZ A,@TTSAR(AR1) ;YUP, SO FETCH THAT
POPJ P, ;RETURN SLOT'S VALUE
STGPNA: SKIPA TT,[SR.PNA] ;RETURN THE PNAME
STGFUN: MOVEI TT,SR.FUN ;RETURN THE FUNCTION
HRRZ A,@TTSAR(AR1)
POPJ P,
STGWOM: MOVEI TT,SR.WOM ;RETURN THE WHICH-OPERATIONS MASK
MOVE D,@TTSAR(AR1) ;GET THE MACHINE NUMBER AND CONS UP A FIXNUM
SETZ A, ;START OFF WITH NIL
STGWO1: JFFO D,STGWO2 ;ANY MORE LEFT TO DO?
POPJ P, ;NOPE, RETURN WITH CONSED UP LIST IN A
STGWO2: HRRZ B,STKNOT(R) ;GET ATOM CORRESPONDING TO MASK BIT
JSP T,%XCONS ;ADD TO THE HEAD OF THE LIST
HRLZI T,400000 ;NOW TURN OFF THE BIT WE JUST HACKED
MOVNS R ;MUST NEGATE TO ROTATE
ROT T,(R) ;SHIFT INTO CORRECT BIT POSITION
TDZ D,T ;TURN OFF THE BIT
JRST STGWO1 ;AND DO THE REMAINING BITS
;SFA-STORE DISPATCH TABLE AND ROUTINES
STSTOU ;USER LOCATION
STSTOD: STSFUN ;FUNCTION
STSWOM ;OPERATIONS MASK
STSPNA ;PRINT NAME
STSTOU: MOVEI A,(C) ;PDLNMK THE THING WE ARE GOING TO STORE
JSP T,PDLNMK
MOVEI TT,SR.FUS(R) ;INDEX INTO ARRAY
JUMPL R,STSTU1 ;RIGHT HALF
HRLM A,@TTSAR(AR1) ;STORE IN THE LEFT HALF
POPJ P, ;RETURN SLOT'S VALUE
STSTU1: HRRM A,@TTSAR(AR1) ;LEFT HALF
POPJ P,
STSPNA: SKIPA TT,[SR.PNA] ;STORE THE PNAME
STSFUN: MOVEI TT,SR.FUN ;STORE THE FUNCTION
HRRZM C,@TTSAR(AR1)
MOVEI A,(C) ;RETURN THE STORED VALUE
CAIE TT,SR.FUN ;WERE WE HACKING THE FUNCTION?
POPJ P, ;NO, SO WE ARE DOINE
HRLI C,(CALL 3,) ;WE MUST ALSO FIX THE CALL INSTRUCTION
MOVEI TT,SR.CAL
MOVEM C,@TTSAR(AR1)
POPJ P,
STSWO1: EXCH A,C
WTA [MUST BE A LIST -- SFA-STORE (WHICH-OPERATIONS)!]
EXCH A,C
STSWOM: SKOTT C,LS ;IS THE ARGUMENT A LIST?
JRST STSWO1 ;NOPE, WRONG TYPE ARG ERROR
PUSH P,AR1 ;SAVE THE SFA FOR STMASK ROUTINE
MOVEI A,(C) ;EXPECTS WHICH-OPERATIONS LIST IN A
JRST STMASK ;THEN GENERATE A NEW MASK AND RETURN
] ;END IFN SFA
PGTOP QIO,[NEW I/O PACKAGE]